Const xDbType = "   1       2    3       4    5        6      7      8        9      a    b           c    d   e   f    g           h         i    j       k       l     m    n"
    Const gDbType = "n/a|Boolean|Byte|Integer|Long|Currency|Single|Double|DateTime|Binary|Text|Long Binary|Memo|n/a|n/a|GUID|Big Integer|VarBinary|Char|Numeric|Decimal|Float|Time|Time Stamp|"

Function saBackUpAcc(Optional outfolder)
    Dim tDbType() As String
    
    If IsMissing(outfolder) Then
        wFol = saGetFolder("Select Folder for Save", True)
        If wFol & "" = "" Then Exit Function
    Else
        wFol = outfolder
    End If
    
    Dim Db As Database
    Set Db = CurrentDb
    
    tDbType = Split(gDbType, "|")
    
    Dim fl
    fl = FreeFile
    
    wFN = wFol & "\@DB.ACDB"
    Open wFN For Output As #fl
    Print #fl, "'***********************************************"
    Print #fl, "'***** Access Database Properties by SIMOZ *****"
    Print #fl, "'***********************************************"
    Print #fl,
    
dbprop:
    Print #fl, "'----- Database Properties -----"
    Print #fl, "'[Name]" & vbTab & "[Type]" & vbTab & "[Value]"
    Print #fl,

    Dim wGUID(15) As Byte
    For i = 0 To Db.Properties.Count - 1
        With Db.Properties(i)
            Select Case .Type
                Case dbBoolean, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbText, dbMemo, dbBigInt, dbChar, dbNumeric, dbDecimal, dbFloat, dbByte
                    Print #fl, .Name & vbTab & tDbType(.Type) & vbTab & .Value
                Case dbTime, dbTimeStamp, dbDate
                    Print #fl, .Name & vbTab & tDbType(.Type) & vbTab & .Value
                Case dbBinary, dbLongBinary, dbVarBinary
                    Print #fl, .Name & vbTab & tDbType(.Type) & vbTab
                    Print #fl, BinHex(.Value, vbTab)
                Case dbGUID
                    Print #fl, .Name & vbTab & tDbType(.Type) & vbTab & BinHex(.Value)
                Case Else
                    Print #fl, .Name & vbTab & .Type & vbTab & "[Not supported]"
                    'Print #fl, BinHex(.Value)
            End Select
        End With
    Next
    
tbldef:
    Print #fl,
    Print #fl, "'----- TableDef(Local) -----"
    Print #fl, "'[Name]" & vbTab & "[SourceTableName]" & vbTab & "[Connect]" & vbTab & "[Create]" & vbTab & "[Last Update]"
    Print #fl,

    Dim tbl As TableDef
    For i = 0 To Db.TableDefs.Count - 1
        Set tbl = Db.TableDefs(i)
        With tbl
          If (Left(tbl.Name, 1) <> "~" And Left(tbl.Name, 4) <> "MSys") Or Left(tbl.Name, 8) = "MSysIMEX" Then
            If tbl.SourceTableName = "" Then
                Print #fl, .Name & vbTab & "[Local Table]" & vbTab & "" & vbTab & Db.Containers("Tables").Documents(.Name).DateCreated & vbTab & Db.Containers("Tables").Documents(.Name).LastUpdated
                ExportXML acExportTable, .Name, wFol & "\" & .Name & ".xml", wFol & "\" & .Name & ".xsd"
            Else
              'Print #fl, .Name & vbTab & .SourceTableName & vbTab & .Connect & vbTab & Db.Containers("Tables").Documents(.Name).DateCreated & vbTab & Db.Containers("Tables").Documents(.Name).LastUpdated
            End If
            'Call saSaveTableDef(.Name, wFol)
            'Debug.Print "Table", .Name, Db.Containers("Tables").Documents(.Name).DateCreated, Db.Containers("Tables").Documents(.Name).LastUpdated
          
            If Left(tbl.Name, 8) = "MSysIMEX" Then
              'Application.SetHiddenAttribute acTable, tbl.Name, True
            End If
          
          End If
        End With
    Next
    
    '--------- Local Tableを先にまとめたいため、上と下で書き込みを分けている！（Import時の都合）
    Print #fl, "'----- TableDef(External) -----"
    Print #fl, "'[Name]" & vbTab & "[SourceTableName]" & vbTab & "[Connect]" & vbTab & "[Create]" & vbTab & "[Last Update]"
    Print #fl,
    
    For i = 0 To Db.TableDefs.Count - 1
        Set tbl = Db.TableDefs(i)
        With tbl
          If (Left(tbl.Name, 1) <> "~" And Left(tbl.Name, 4) <> "MSys") Or Left(tbl.Name, 8) = "MSysIMEX" Then
            If tbl.SourceTableName = "" Then
              'Print #fl, .Name & vbTab & "[Local Table]" & vbTab & "" & vbTab & Db.Containers("Tables").Documents(.Name).DateCreated & vbTab & Db.Containers("Tables").Documents(.Name).LastUpdated
            Else
              Print #fl, .Name & vbTab & .SourceTableName & vbTab & .Connect & vbTab & Db.Containers("Tables").Documents(.Name).DateCreated & vbTab & Db.Containers("Tables").Documents(.Name).LastUpdated
            End If
          End If
        End With
    Next
    
relation:
    Print #fl,
    Print #fl, "'----- Relation -----"
    Print #fl,

    Dim rel As relation
    For i = 0 To Db.Relations.Count - 1
        Set rel = Db.Relations(i)
        With rel
          If Left(.Name, 1) <> "~" And Left(.Name, 4) <> "MSys" Then
            
            'Debug.Print "Relation", .Name, .Table, .ForeignTable, db.Containers("Relationships").Documents(.Name).DateCreated, db.Containers("Relationships").Documents(.Name).LastUpdated
            Print #fl, .Name
            Dim pp As Property
            For H = 0 To .Properties.Count - 1
                Set pp = .Properties(H)
                If pp.Name <> "Name" Then
                    Select Case pp.Type
                        Case dbBoolean, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbText, dbMemo, dbBigInt, dbChar, dbNumeric, dbDecimal, dbFloat, dbByte, dbTime, dbTimeStamp, dbDate
                            
                            On Error Resume Next
                            Print #fl, vbTab & pp.Name & vbTab & tDbType(pp.Type) & vbTab & pp.Value
                            If Err = 3032 Then
                                'MsgBox 3032
                                Print #fl, vbTab & pp.Name & vbTab & tDbType(pp.Type) & vbTab & ""
                            End If
                            On Error GoTo 0
                        Case dbBinary, dbLongBinary, dbVarBinary
                            Print #fl, vbTab & pp.Name & vbTab & tDbType(pp.Type) & vbTab & pp.Value
                            Print #fl, BinHex(pp.Value, vbTab & vbTab)
                        Case dbGUID
                            Print #fl, vbTab & pp.Name & vbTab & tDbType(pp.Type) & vbTab & pp.Value & vbTab & BinHex(pp.Value, vbTab)
                        Case Else
                            Print #fl, vbTab & pp.Name & vbTab & tDbType(pp.Type) & vbTab & pp.Value & vbTab & "[Not supported]"
                    End Select
                End If
            Next
            
            For j = 0 To .Fields.Count - 1
                Print #fl, vbTab & "Field" & vbTab & "Name:" & .Fields(j).Name & vbTab & "ForeignName:" & .Fields(j).ForeignName
            Next

          End If
        End With
    Next
    
Menus:
    Print #fl,
    Print #fl, "'----- Menus and Toolbars -----"
    Print #fl, 'https://msdn.microsoft.com/ja-jp/library/cc377025.aspx
    Print #fl, "         not supported"

    'For i = 1 To Application.CommandBars.Count
    '    With Application.CommandBars(i)
    '        Dim hdr
    '        hdr = "(" & Format(i, "000") & ") " & .Name & vbTab & .BuiltIn & vbTab & .Creator & vbTab & .AdaptiveMenu & vbTab & .Parent
    '        dtlcnt = 0
    '        For j = 1 To .Controls.Count
    '            If .Controls(j).BuiltIn = True Then
    '                If dtlcnt = 0 Then Print #fl, hdr
    '                Print #fl, vbTab & .Controls(j).Caption & vbTab & .Controls(j).BuiltIn & vbTab & .Controls(j).Creator
    '                dtlcnt = dtlcnt + 1
    '            End If
    '        Next
    '    End With
    'Next

ImpExpSpec:
    Print #fl,
    Print #fl, "'----- Import/Export Specs -----"
    Print #fl,
    
    IMEXExist = False
    For Each tx In Db.TableDefs
        If tx.Name = "MSysIMEXSpecs" Then IMEXExist = True
    Next
    If IMEXExist = True Then
        'ExportXML acExportTable, "MSysIMEXSpecs", wFol & "\MSysIMEXSpecs.XML"
        'ExportXML acExportTable, "MSysIMEXColumns", wFol & "\MSysIMEXColumns.XML"
    
        Dim Def As Recordset
        Set Def = Db.OpenRecordset("MSysIMEXSpecs", DB_OPEN_SNAPSHOT)
        Print #fl, "[[ Specs ]]"
        Print #fl, vbTab & "[SpecID]" & vbTab & "[SpecName]" & vbTab & "[SpecType]" & vbTab & "[FieldSeparator]" & vbTab & "[TextDelim]" & vbTab & "[FileType]" & vbTab & "[DateOrder]" & vbTab & "[DateFourDigitYear]" & vbTab & "[DateDelim]" & vbTab & "[DateLeadingZeros]" & vbTab & "[TimeDelim]" & vbTab & "[DecimalPoint]" & vbTab & "[StartRow]"
        
        Do While Not Def.EOF
            Print #fl, vbTab & Def![SpecID] & vbTab & Def![SpecName] & vbTab & Def![SpecType] & vbTab & Separator(Def![FieldSeparator], True) & vbTab & Def![TextDelim] & vbTab & Def![FileType] & vbTab & Def![DateOrder] & vbTab & Def![DateFourDigitYear] & vbTab & Def![DateDelim] & vbTab & Def![DateLeadingZeros] & vbTab & Def![TimeDelim] & vbTab & Def![DecimalPoint] & vbTab & Def![StartRow]
            Def.MoveNext
        Loop
        Def.Close
        
        Set Def = Db.OpenRecordset("MSysIMEXColumns", DB_OPEN_SNAPSHOT)
        Print #fl, "[[ Columns ]]"
        Print #fl, vbTab & "[SpecID]" & vbTab & "[FieldName]" & vbTab & "[SkipColumn]" & vbTab & "[DataType]" & vbTab & "[Attributes]" & vbTab & "[IndexType]" & vbTab & "[Start]" & vbTab & "[Width]"
        Do While Not Def.EOF
            Print #fl, vbTab & Def![SpecID] & vbTab & Def![FieldName] & vbTab & Def![SkipColumn] & vbTab & Def![DataType] & vbTab & Def![Attributes] & vbTab & Def![IndexType] & vbTab & Def![Start] & vbTab & Def![Width]
            Def.MoveNext
        Loop
        Def.Close
        Set Def = Nothing
    
    End If
    
NavPane:
    Print #fl,
    Print #fl, "'----- Nav Pane Groups -----"
    Print #fl,
    Print #fl, "        not supported"

ImgTheme:
    Print #fl,
    Print #fl, "'----- All Images And Themes -----"
    Print #fl,
    Dim Resource As Recordset
    Set Resource = Db.OpenRecordset("MSysResources", DB_OPEN_SNAPSHOT)
    Print #fl, "[ID]" & vbTab & "[Name]" & vbTab & "[Type]" & vbTab & "[Extension]"
    Do While Not Resource.EOF
        Set rsAttch = Resource.Fields("Data").Value
        AttIDX = 1
        While Not rsAttch.EOF
            AttFileName = "@MSysResource_" & Resource![Name] & "_" & AttIDX & "_" & rsAttch.Fields("FileName")
            If Dir(wFol & "\" & AttFileName) <> "" Then Kill wFol & "\" & AttFileName
            rsAttch.Fields("FileData").SaveToFile wFol & "\" & AttFileName
            'Print #fl, "Export Resouce as " & AttFileName
            AttIDX = AttIDX + 1
            rsAttch.MoveNext
        Wend
        If AttIDX > 2 Then MsgBox "Image Resouce Attach Count over 1. Not supported!"
        Print #fl, Resource![ID] & vbTab & Resource![Name] & vbTab & Resource![Type] & vbTab & Resource![Extension] & vbTab & AttFileName
        
        Resource.MoveNext
    Loop
    Resource.Close
    Set Resource = Nothing

query:
    Print #fl,
    Print #fl, "'----- Query -----"
    Print #fl,
    
    Dim qry As QueryDef
    For i = 0 To Db.QueryDefs.Count - 1
        Set qry = Db.QueryDefs(i)
        With qry
          If Left(.Name, 1) <> "~" And Left(.Name, 4) <> "MSys" Then
            Print #fl, .Name & vbTab & Db.Containers("Tables").Documents(.Name).DateCreated & vbTab & Db.Containers("Tables").Documents(.Name).LastUpdated
            SaveAsText acQuery, .Name, wFol & "\" & .Name & ".ACQ"
            Debug.Print "Query", .Name, Db.Containers("Tables").Documents(.Name).DateCreated, Db.Containers("Tables").Documents(.Name).LastUpdated
          End If
        End With
    Next
    
Form:
    Print #fl,
    Print #fl, "'----- Form -----"
    Print #fl,
    For Each mydoc In Db.Containers("Forms").Documents
        Print #fl, mydoc.Name & vbTab & CurrentProject.AllForms(mydoc.Name).DateCreated & vbTab & CurrentProject.AllForms(mydoc.Name).DateModified
        SaveAsText acForm, mydoc.Name, wFol & "\" & mydoc.Name & ".ACF"
        Debug.Print "Form", CurrentProject.AllForms(mydoc.Name).DateCreated, CurrentProject.AllForms(mydoc.Name).DateModified
    Next
    
Report:
    Print #fl,
    Print #fl, "'----- Report -----"
    Print #fl,
    For Each mydoc In Db.Containers("Reports").Documents
        Print #fl, mydoc.Name & vbTab & CurrentProject.AllReports(mydoc.Name).DateCreated & vbTab & CurrentProject.AllReports(mydoc.Name).DateModified
        SaveAsText acReport, mydoc.Name, wFol & "\" & mydoc.Name & ".ACR"
        Debug.Print "Report", CurrentProject.AllReports(mydoc.Name).DateCreated, CurrentProject.AllReports(mydoc.Name).DateModified
    Next
    
AccessPage:
    'Print #fl,
    'Print #fl, "'----- DataAccessPage -----"
    'Print #fl,
    'For Each mydoc In db.Containers("DataAccessPages").Documents
    '    Print #fl, .Name & vbTab & db.Containers("DataAccessPages").Documents(.Name).DateCreated & vbTab & db.Containers("DataAccessPages").Documents(.Name).LastUpdated
    '    'SaveAsText  'acReport, mydoc.Name, wFol & "\" & mydoc.Name & ".ACR"
    '    Debug.Print "Report", CurrentProject.AllReports(mydoc.Name).DateCreated, CurrentProject.AllReports(mydoc.Name).DateModified
    'Next
    
Macro:
    Print #fl,
    Print #fl, "'----- Macro -----"
    Print #fl,
    For Each mydoc In Db.Containers("Scripts").Documents
        If Left(mydoc.Name, 1) <> "~" Then
            Print #fl, mydoc.Name & vbTab & CurrentProject.AllMacros(mydoc.Name).DateCreated & vbTab & CurrentProject.AllMacros(mydoc.Name).DateModified
            SaveAsText acMacro, mydoc.Name, wFol & "\" & mydoc.Name & ".ACS"
            Debug.Print "Macro", CurrentProject.AllMacros(mydoc.Name).DateCreated, CurrentProject.AllMacros(mydoc.Name).DateModified
        End If
    Next
    
Module:
    Print #fl,
    Print #fl, "'----- Module -----"
    Print #fl,
    For Each mydoc In Db.Containers("Modules").Documents
        Print #fl, mydoc.Name & vbTab & CurrentProject.AllModules(mydoc.Name).DateCreated & vbTab & CurrentProject.AllModules(mydoc.Name).DateModified
        SaveAsText acModule, mydoc.Name, wFol & "\" & mydoc.Name & ".ACM"
        Debug.Print "Module", mydoc.Name, CurrentProject.AllModules(mydoc.Name).DateCreated, CurrentProject.AllModules(mydoc.Name).DateModified
    Next

fclose:
    Close #fl
    MsgBox "End BackUp"
End Function

Function BinHex(wByte() As Byte, Optional FirstChar As String) As String
    Dim w1st As String
    If IsMissing(FirstChar) Then w1st = "" Else w1st = FirstChar
    Dim wALL As String
    For i = 0 To UBound(wByte) Step 32
        wStr = w1st & "0x"
        For j = 0 To 31
            P = i + j
            If UBound(wByte) >= P Then wStr = wStr & LCase(Right("0" & Hex(wByte(P)), 2))
        Next
        wALL = wALL & wStr & " ," & vbCrLf
    Next
    If wALL = "" Then wALL = "    "
    BinHex = Left(wALL, Len(wALL) - 4)
End Function

Function Separator(wIn, FLG)
    Select Case FLG
        Case True
            If wIn = vbTab Then
                Separator = "vbTab"
            Else
                Separator = wIn
            End If
        Case False
            If wIn = "vbTab" Then
                Separator = vbTab
            Else
                Separator = wIn
            End If
    End Select
End Function