Go to Qiita Advent Calendar 2024 Top
LoginSignup
27
45

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 5 years have passed since last update.

@Q11Q

Accessで必ず使うVBA ほぼ完全なエクスポート 全オブジェクト+参照設定リストをエクスポート

Last updated at Posted at 2017-09-30

#Accessで重要なことはバックアップ
特に設定の書き出しが重要です。
AccessとかExcelでVBAのソースを一括でテキストに書き出す - 面倒、死のう 2008-09-20
AccessのVBAソースを一括エクスポートするからさらに鍛え上げて

  • オブジェクトのテキスト出力
    • フォーム*.frm ただしパラメーター入力が必要なものを除く
    • レポート*.rpt
    • マクロ *.mcr
    • モジュール *.bas
    • クエリ *.qry（とSQL \*_SQL.txt）VBS版のみ新機能 UTF-8版でのSQLの出力
    • VBA参照設定 \VBAReferenceList_Utf8.csv
  • オブジェクトのXML出力
  • テーブルのスキーマ及びシステムテーブルのXML出力 BackUpオプションによって全データをXMLバックアップ可能
  • 外部データのインポート、エクスポートの情報とXML出力 ALLImportExportSpecification.txt
  • クエリは選択、クロス集計、ユニオンのみXML出力(VBSのみ)
  • フォームのスキーマ(*.xsd)出力フルバックアップオプションによりテーブルデータXMLをともなった出力が可能だが、関連するテーブルデータがオブジェクトごとに出力される。ただしパラメーターがついている場合を除く。
  • レポートのスキーマ(*.xsd)及びプレゼンテーションデータ(*.xsl)。フルバックアップオプションによりテーブルデータXMLをともなった出力が可能だが、関連するテーブルデータがオブジェクトごとに出力される。ただしパラメーターがついている場合を除く。
  • NavigationPane(VBS)
  • データーベースのオブジェクトの名称一覧と基本接続文字列等 AllObjName_CNStrList_Utf8.txt
  • データベースの設定 DataBaseProperties_Utf8.csv
  • テーブルの設定 各テーブルの各フィールドのプロパティ*Utf8.csv
  • リンクテーブルの名称と疑似インデックスの有無、重複、主キー LLinkTable_Information.txt
  • リンクテーブルの情報をADOX.Catalogで出力 AllLinkTalbeData.txt
  • 各クエリのプロパティ *Utf8.csv
  • VBAのプロシージャ名リスト ALLModuleProcedureNamelist.txt
  • システムテーブルのXMLエクスポート
  • Const blTableBackUpMode = True時はシステムテーブルを含めすべてのテーブルをXML出力
  • Accessをバックグラウンドで開く不可視モードオプション(blVisible = False)
  • DBEngineのバージョン情報 AccessVersionInfo.txt
  • Printerの一覧 AccessVersionInfo.txt
  • 環境変数の情報 EnvironmentVariable.txt
  • ウィンドウズシステムの情報 SystemInfo.Csv
  • 2017/11/24New！ Accessのオプションの設定の出力(VBSのみ、2013以上で動作確認)AccessGetOption_Utf8.txt
  • 32Bit用最適化オプション
  • 出力されたファイルのリスト FSOAccessObjectExPortFileList.txt
  • Access 2013 Later コンテナオブジェクトのプロパティ AllContainerProperty_utf8.txt

##パラメータークエリはXML出力ができない
パラメータクエリーをVBAから使うには？
フォーム参照のパラメータクエリをVBAで扱う方法
これらのように個別で値を指定しても出力がうまくいかないので、ここは出力できないようにした。パラメーターが付加されているかどうかは、クエリだけが判定できるため、クエリは除外して出力ができる。
ただし、出力の有無は、
Const hasParameter = True
のように、ファイルの中身をわかっている人が、Trueに定義するようにしています。よくわからないファイルを開く場合にはFalseではなくTrueを推奨します。
　なお、ナヴィゲーションパネルから右クリックで選んでXMLエクスポートしようとしても
#####バインドされていないフォームまたはレポートをXMLドキュメントとしてエクスポートすることはできません
　というエラーがでてしまい、XML出力ができません。
#####さらに不思議なことに
　このVBSでもまだパラメーターを求められますが、Rpt形式は出力されます。Frmはだめです。もっともパラメータは１．VBAによる、２．フォーム（を挟んでクエリ）による、３。クエリによる３つ以上の場合があり、２は出力できるようです。なのでHasparameterオプションをつけていません。

ADOXはVBSではCurrentProject.Connectionが使えないらしい。

このためaccdb,mdbでProviderを分けました。

VBS Alltablesオブジェクトでエラーが出る

コメント欄で指摘されたエラーです。これはFor Eachではなく For i = AllTables.Count
でやると発生できることがわかりました。
そこでカウントが0より大きい時に逆順でテキストファイルに記録するようにしてみました。

PerfectExport.vbs

'http://techbank.jp/Community/blogs/mymio/archive/2009/01/22/4480.aspxを改良(?)
'----------------------------------------------------------------
' For VBA
'---------------------------------------------------------------
'#If VBA7 Then
'Private Declare PtrSafe Sub WScript.Sleep Lib "kernel32" (ByVal ms As LongPtr)
'#Else
'Private Declare Sub WScript.Sleep Lib "kernel32" (ByVal ms As Long)
'#End If

'-----------------------------------------------------------------
' 定数
'-----------------------------------------------------------------

'Dim vbext_ct_ClassModule, vbext_ct_Document, vbext_ct_MSForm, vbext_ct_StdModule
Const vbext_ct_ClassModule = 2
Const vbext_ct_Document = 100
Const vbext_ct_MSForm = 3
Const vbext_ct_StdModule = 1
'''''''' Access.AcObjectType
Const acQuery = 1
Const acReport = 3
Const acModule = 5
Const acMacro = 4
Const acDatabaseProperties = 11
Const acDiagram = 8
Const acFunction = 10
Const acTable = 0
Const acForm = 2
'''''''' ADODB.Stream
Const adWriteChar = 0
Const adWriteLine = 1
Const adTypeText = 2
Const adTypeBinary = 1,adModeReadWrite = 3

'''''''''Access.Apllicastin Syscmd AcSysCmdAction 列挙
Const acSysCmdClearStatus = 5
Const acSysCmdAccessDir = 9
Const acSysCmdGetWorkgroupFile = 13
Const acSysCmdIniFile = 8
Const acSysCmdProfile = 12
Const acSysCmdRuntime = 6
Const acSysCmdAccessVer = 7
'''''''' Access.AcImportXMLOption
Const acAppendData = 2
Const acStructureOnly = 0 'テーブルの構造のみ
Const acStructureAndData = 1
'''''''' Access.AcExportXMLObjectType
Const acExportTable = 0
Const acExportForm = 2
Const acExportFunction = 10
Const acExportQuery = 1
Const acExportReport = 3
Const acExportServerView = 7
Const acExportStoredProcedure = 9
'''''''' DAO.TableDefAttributeEnum
Const dbSystemObject = -2147483646
Const dbHiddenObject = 1
'''''''' Access.AcDataTransferType
Const acExport = 1
Const acUTF8 = 0
''''''''
Const acExportAllTableAndFieldProperties = 32
Const acPersistReportML = 16
Const acEmbedSchema = 1
'''''''' Access.AcQuitOption,Access.AcCloseSave
Const acQuitSaveAll = 1
Const acQuitSaveNone = 2, acSaveNo = 2
'''''''' DAO.QueryDefTypeEnum
Const dbQSetOperation = 128
Const dbQSelect = 0
Const dbQCrosstab = 16
'''''''' Special BackUp Option
Const hasParameter = True 'レポート、フォームにパラメーターがあるとき、不明なときはTrueにしてください。
Const blVisible = False 'Falseの時バックグラウンドで開く
Const blTableBackUpMode = False 'テーブル/レポートのデータをXML形式でバックアップします。テーブルが大きいとバックアップ容量、時間がかかるので通常はFalseにしてください。
'-----------------------------------------------------------------
' 変数宣言
'-----------------------------------------------------------------
Dim inFileName, fs, inFile, outPath, outFolder
Dim accessObj, vbproject, vbcComp, moduleName, cDB, cProj
Dim FilePath, Ext, objColl, obj, sr, str, buf
Dim prop, tdf, tdfName, fld, flds, fldp, p, ref, Q, sSQL, oSQL, oFile, vBuffer, cmdStr, v, idx, CNT, rFol, oLog
Dim DBEngine, intI, strProps, strDestination, ProcNames, i, ctrLoop, prpLoop
Dim imexObjs, imexObj
Dim CAT, cTBL, DT, List, c, tbName

'--------------------------------------------------------------
' メイン
'-----------------------------------------------------------------
inFileName = Wscript.Arguments(0) 'VBScript
'inFileName = "E:\FileList.accdb"
Set fs = CreateObject("Scripting.FileSystemObject")
Set inFile = fs.GetFile(inFileName)
outPath = inFile.ParentFolder.Path & "\" & Replace(inFile.Name, ".", "_", 1, -1) & "_text"

' 出力フォルダが存在していれば消して作り直す
If fs.FolderExists(outPath) Then
fs.DeleteFolder outPath, True
End If
WScript.Sleep 1000 'In Case VBA WScript.Sleep >>> Sleep
fs.CreateFolder (outPath)
WScript.Sleep 500 'In Case VBA WScript.Sleep >>> Sleep
fs.CreateFolder (outPath & "\IMG"): WScript.Sleep 500 'In Case VBA WScript.Sleep >>> Sleep
Set outFolder = fs.GetFolder(outPath): rFol = outFolder.Path & "\": Set oLog = fs.CreateTextFile(outFolder.Path & "\" & "AccessOUTPutLog.txt"):oLog.Write "Line 106 :Start :" & cstr(Now)
Olog.Write "Line 107 Version の記録 " & Cstr(Now) & vbCrlf '''' Accessを起動し、バージョン情報を記録する. --------------------------------------------
On Error Resume Next
'''' Make Link Table Infomation -[VBS]-----------------------------
Set CAT = CreateObject("ADOX.Catalog")
Set cTBL = CreateObject("ADOX.Table")
Set oSQL = fs.CreateTextFile(outFolder.Path & "\AllLinkTalbeData.txt")
If fs.GetExtensionName(inFileName) = "accdb" Then
CAT.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & inFileName & ";Extended Properties="""""
Else
CAT.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & inFileName
End If
'カレントデータベースに接続
On Error Resume Next
oSQL.Write "DatabaseName" & "," & "tablename" & "," & "Type" & "," & "DateCreate" & "," & "Datelastmodified" & vbCrLf
For Each cTBL In CAT.Tables
If cTBL.Type = "LINK" Or cTBL.Type = "PASS-THROUGH" Then
If Minute(DT - CDate(cTBL.DateModified)) <= 24 * 60 Then List.Add cTBL.Name ' list.Add tbDef.Name
oSQL.Write """" & fs.GetBasename(cDB.Name) & " Link Table :""" & ", """ & cTBL.Name & """,""" & cTBL.Type & """,""" & cTBL.DateCreated & """,""" & cTBL.DateModified & """" & vbCrLf
oSQL.Write "Keys.count := " & cTBL.Keys.Count & vbCrLf
oSQL.Write "indexes.count := " & cTBL.Indexes.Count & vbCrLf
oSQL.Write "columns.count := " & cTBL.Columns.Count & vbCrLf
If cTBL.Indexes.Count > 0 Then
For Each idx In cTBL.Indexes
oSQL.Write idx.DistinctCount, idx.IgnoreNulls, idx.Primary
If Err.Number <> 0 Then Err.Clear: oSQL.Write idx.Name
Next
Else
oSQL.Write "No Indexes"
End If
'''''''''' Link Table Index. -[ VBS ] ------------------------------------------------------------------
If cTBL.Keys.Count > 0 Then
oSQL.Write cTBL.Name & "keys.count & list " & "Keys.count is " & cTBL.Keys.Count
For Each p In cTBL.Keys
oSQL.Write p.Columns.Count, p.deleteRule, p.RelatedTable, p.Type, p.Name
If p.Columns.Count > 0 Then
For Each c In p.Columns
oSQL.Write c.Attributes, c.Attributes, c.Name, c.NumericScale, c.Precision
If Err.Number <> 0 Then Err.Clear: oSQL.Write c.Name
Next
End If
Next
Else
oSQL.Write "No Keys"
End If
'Next
'End If
'''''''''' Link Table Columns. -[ VBS ] ------------------------------------------------------------------
If cTBL.Columns.Count > 0 Then
For Each c In cTBL.Columns
oSQL.Write "Columnslist :" & c.Attributes, c.DefinedSize, c.Name, c.NumericScale, c.Precision, c.Type
If Err.Number <> 0 Then
Err.Clear
'oSQL.Write Err.Number & "," & Err.Description & vbCrLf: Err.Clear
oSQL.Write "Columnslist :" & "name " & c.Name & ",Typ:" & c.Type & vbCrLf
'If Err.Number <> 0 Then oSQL.Write Err.Number & "," & Err.Description & "," & c.Name & vbCrLf: Err.Clear
If Err.Number <> 0 Then oSQL.Write c.Name & vbCrLf: Err.Clear
End If
Next
End If
'End If
'Next
'''''''''' Link Table Columns. -[ VBS ] ------------------------------------------------------------------
oSQL.Write vbCrLf & vbCrLf & "----------------- Simple Link Table Name List. -----------------------------" & vbCrLf
For Each tbName In List
oSQL.Write tbName
Next
End If 'If cTBL.Type = "LINK" Or cTBL.Type = "PASS-THROUGH" Then
Next
oSQL.Close
Set CAT = Nothing: cTBL = Nothing:wscript.sleep 1000
'''''''''' [[END]] Make Link Table Infomation. -[ VBS ] ------------------------------------------------------------------

'''''''' accdb/mdbを開く. -[VBS]-----------------------------------------------------------
Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & "AccsessVersionInfo.txt")
Set accessObj = CreateObject("Access.Application")
accessObj.OpenCurrentDatabase inFileName, True
If blVisible = True Then accessObj.Visible = True: accessObj.UserControl = True
Set cDB = accessObj.CurrentDb
'Ser cProj = AccessObj.CurrentProject
oLog.Write "Record Access Application Information " & cStr(now) & vbCrLf '''''''' 情報の記録. -------------------------------------------------------------------------------
oSQL.Write accessObj.SysCmd(acSysCmdAccessDir) & " にバージョン " & _
accessObj.Version & " がインストールされています." & vbCrLf
oSQL.Write "以下は該当がないときは左には何も表示されていません," & vbCrLf & _
accessObj.SysCmd(acSysCmdIniFile) & " ;iniファイルがあれば左に場所が示されます. (acSysCmdIniFile) " & vbCrLf & _
accessObj.SysCmd(acSysCmdClearStatus) & " :左にデータベース オブジェクトの状態についての情報を提供します. (acSysCmdClearStatus) " & vbCrLf & _
accessObj.SysCmd(acSysCmdRuntime) & " :左にAccess のランタイム バージョンが実行されている場合は、True(-1) を返します. (acSysCmdRuntime) " & vbCrLf & _
accessObj.SysCmd(acSysCmdGetWorkgroupFile) & " :左にワークグループ ファイル (System.mdw) のパスを返します. (acSysCmdGetWorkgroupFile) " & vbCrLf & _
accessObj.SysCmd(acSysCmdProfile) & " :左にAccess をコマンド ラインから起動するときに指定した /profile を返します. (acSysCmdProfile) "
'On Error Resume Next
oSQL.Write "Application Visible property = " & accessObj.Visible
If blVisible = False Then accessObj.UserControl = True
For intI = 0 To accessObj.DBEngine.Properties.Count - 1
oSQL.Write strProps & accessObj.Applicaton.DBEngine.Properties(intI).Name & ", "
Next
If blVisible = False Then accessObj.UserControl = True

oSQL.Write strProps & vbCrLf 'On Error Resume Next
oSQL.Write "Application Visible property = " & accessObj.Visible
'''''''' DBEngin Properties List. -[VBS]-------------------------------
If blVisible = False Then accessObj.UserControl = True
For intI = 0 To accessObj.Application.DBEngine.Properties.Count - 1
strProps = strProps & intI & "," & accessObj.Application.DBEngine.Properties(intI).Name & vbCrLf
If Err.Number <> 0 Then strProps = strProps & intI & "," & "error": Err.Clear
buf = buf & intI & "," & accessObj.Application.DBEngine.Properties(intI).Name & ", " & accessObj.Application.DBEngine.Properties(intI).Value
If Err.Number <> 0 Then buf = buf & intI & "," & "error": Err.Clear
buf = buf & vbCrLf
Next
oSQL.Write "DBEngine.Properties List" & vbCrLf & strProps & vbCrLf
oSQL.Write "DBEngine.Properties Name And Valur List" & vbCrLf & buf
If blVisible = False Then accessObj.UserControl = False
'''''''' Printer Properties List. -[VBS]-------------------------------
If accessObj.Application.Printers.Count > 0 Then
i = 1 : oLog.Write "Line 218 Printer List " & vbCrLf
oSQL.Write "Printer Properties List.Total = " & accessObj.Application.Printers.Count & vbCrLf
For Each v In accessObj.Application.Printers
With v
oSQL.Write "Device name: " & .DeviceName & vbCr _
& "Driver name: " & .DriverName & vbCr _
& "Port: " & .Port & " " & i & "/Printers.count:" & accessObj.Application.Printers.Count & vbCrLf
End With
i = i + 1
Next
End If
'''''''' Record Information End Statement. -[VBS]--------
oSQL.Close
Set oSQL = Nothing
'''' モジュールをテキスト化. -[VBS]-------------------------------------------------------------------

accessObj.Application.ExportNavigationPane rFol & "\exptNaviGationpane.xml"
Set vbproject = accessObj.VBE.ActiveVBProject
For Each vbcComp In vbproject.VBComponents
Select Case vbcComp.Type
Case vbext_ct_Document, vbext_ct_StdModule
Ext = ".bas"
Case vbext_ct_ClassModule
Ext = ".cls"
Case vbext_ct_MSForm
Ext = ".frm"
Case Else
Ext = ""
End Select
' Accessでは、「/」 入りのモジュール名を作成することができるが
' モジュールファイルをエクスポートするとOSの問題で、
' 「/」入りのファイル名を保存することができない
' そのため、「/」文字を「_」に変換してエクスポートする
moduleName = Replace(vbcComp.Name, "/", "_")
vbcComp.Export (outFolder.Path & "\" & moduleName & Ext)
Next
'''''''' Prodedure Name List. -[VBS]------------------------------------
Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & "ALLModuleProcedurelist.txt")
For Each v In accessObj.CurrentProject.AllModules
With accessObj.Application.VBE.ActiveVBProject.VBComponents(v.Name).CodeModule
For i = 1 To .CountOfLines
If buf <> .ProcOfLine(i, 0) Then
buf = .ProcOfLine(i, 0)
ProcNames = v.Name & vbTab & ProcNames & buf & vbCrLf
End If
Next
End With
Next
oSQL.Write "Procedure Name List " & vbCrLf & ProcNames: oSQL.Close: Set oSQL = Nothing
'''' ADODB Stream Variable Set !!!! ---------------------------------------------
Set sr = CreateObject("ADODB.Stream") 'For Makeing UTF-8 text file (with BOM)
'''' [[ End ]] ADODB Stream Variable Set !!!!---------------------------------------------
oLog.Write "Line 270 GetOption"
sr.Mode = 3 '読み取り/書き込みモード'270
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
On Error Resume Next
If accessObj.BrokenReference = True Then '2019/6/1追加
sr.WriteText "[参照設定]VBAの参照設定で壊れている、参照不可のものがあります。" & vbCrLf , 0
Else
sr.WriteText "[参照設定]VBAの参照設定で壊れている、参照不可のものはないようです。" & vbCrLf , 0
End IF
sr.WriteText "[基本設定]タブ:[データベースの作成] セクション:新規データベースの並び順序/New database sort order = " & accessObj.GetOption("New Database Sort Order") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[データベースの作成] セクション:既定のデータベース フォルダー/Default database folder = " & accessObj.GetOption("Default Database Directory") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[データベースの作成] セクション:既定のファイル形式/Default file format = " & accessObj.GetOption("Default File Format") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[カレント データベース]:閉じる時に最適化する/Compact on Close = " & accessObj.GetOption("Auto Compact") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[カレント データベース]:ファイルを保存するときにファイルのプロパティから個人情報を削除する/Remove personal information from file properties on save = " & accessObj.GetOption("Remove Personal Information") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[カレント データベース]:フォーム上のコントロールに Windows のテーマを使用する/Use Windows-themed Controls on Forms = " & accessObj.GetOption("Themed Form Controls") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[カレント データベース]:このデータベースのレイアウト ビューを有効にする/Enable Layout View for this database = " & accessObj.GetOption("DesignWithData") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[カレント データベース]:数値フィールドの文字切れをチェックする/Check for truncated number fields = " & accessObj.GetOption("CheckTruncatedNumFields") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[カレント データベース]:Picture プロパティの保存形式/Picture Property Storage Format = " & accessObj.GetOption("Picture Property Storage Format") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[名前の自動修正オプション] セクション:名前の自動修正情報をトラックする/Track name AutoCorrect info = " & accessObj.GetOption("Track Name AutoCorrect Info") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[名前の自動修正オプション] セクション:名前の自動修正を行う/Perform name AutoCorrect = " & accessObj.GetOption("Perform Name AutoCorrect") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[名前の自動修正オプション] セクション:名前の自動修正の変更を記録する/Log name AutoCorrect changes = " & accessObj.GetOption("Log Name AutoCorrect Changes") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[<データベース名> データベースのフィルター ルックアップ オプション] セクション:値リストを表示するフィールド、 ローカル インデックス フィールド/Show list of values in, Local indexed fields = " & accessObj.GetOption("Show Values in Indexed") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[<データベース名> データベースのフィルター ルックアップ オプション] セクション:値リストを表示するフィールド、 ローカル非インデックス フィールド/Show list of values in, Local nonindexed fields = " & accessObj.GetOption("Show Values in Non-Indexed") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[<データベース名> データベースのフィルター ルックアップ オプション] セクション:値リストを表示するフィールド、 ODBC フィールド/Show list of values in, ODBC fields = " & accessObj.GetOption("Show Values in Remote") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[<データベース名> データベースのフィルター ルックアップ オプション] セクション:値リストを表示するフィールド、 ローカル スナップショットのレコード/Show list of values in, Records in local snapshot = " & accessObj.GetOption("Show Values in Snapshot") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[<データベース名> データベースのフィルター ルックアップ オプション] セクション:値リストを表示するフィールド、 サーバーのレコード/Show list of values in, Records at server = " & accessObj.GetOption("Show Values in Server") & vbCrLf , 0
sr.WriteText "[基本設定]タブ:[<データベース名> データベースのフィルター ルックアップ オプション] セクション:レコード数が次の値を超えるときは、リストを表示しない/Don't display lists where more than this number of records read = " & accessObj.GetOption("Show Values Limit") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定の色] セクション:フォントの色/Font color = " & accessObj.GetOption("Default Font Color") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定の色] セクション:背景色/Background color = " & accessObj.GetOption("Default Background Color") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定の色] セクション:代替の背景色/Alternate background color = " & accessObj.GetOption("_64") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定の色] セクション:枠線の色/Gridlines color = " & accessObj.GetOption("Default Gridlines Color") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[枠線とセルの表示] セクション:枠線の表示、 水平/Default gridlines showing, Horizontal = " & accessObj.GetOption("Default Gridlines Horizontal") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[枠線とセルの表示] セクション:枠線の表示、 垂直/Default gridlines showing, Vertical = " & accessObj.GetOption("Default Gridlines Vertical") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[枠線とセルの表示] セクション:セルの立体表示/Default cell effect = " & accessObj.GetOption("Default Cell Effect") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[枠線とセルの表示] セクション:既定の列幅/Default column width = " & accessObj.GetOption("Default Column Width") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定のフォント] セクション:フォント/Font = " & accessObj.GetOption("Default Font Name") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定のフォント] セクション:サイズ/Size = " & accessObj.GetOption("Default Font Size") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定のフォント] セクション:太さ/Weight = " & accessObj.GetOption("Default Font Weight") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定のフォント] セクション:下線/Underline = " & accessObj.GetOption("Default Font Underline") & vbCrLf , 0
sr.WriteText "[データシート] タブ:[既定のフォント] セクション:斜体/Italic = " & accessObj.GetOption("Default Font Italic") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[テーブル デザイン] セクション:テキスト型のフィールド サイズ/Default text field size = " & accessObj.GetOption("Default Text Field Size") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[テーブル デザイン] セクション:数値型のフィールド サイズ/Default number field size = " & accessObj.GetOption("Default Number Field Size") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[テーブル デザイン] セクション:既定のデータ型/Default field type = " & accessObj.GetOption("Default Field Type") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[テーブル デザイン] セクション:インデックスを自動作成するフィールド/AutoIndex on Import/Create = " & accessObj.GetOption("AutoIndex on Import/Create") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[テーブル デザイン] セクション:[プロパティの更新オプション] ボタンを表示する/Show Property Update Option Buttons = " & accessObj.GetOption("Show Property Update Options Buttons") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:テーブル名を表示する/Show table names = " & accessObj.GetOption("Show Table Names") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:すべてのフィールドを表示する/Output all fields = " & accessObj.GetOption("Output All Fields") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:フィールドの自動結合/Enable AutoJoin = " & accessObj.GetOption("Enable AutoJoin") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:SQL サーバー互換構文 (ANSI 92)、 このデータベース/SQL Server Compatible Syntax (ANSI 92), This database = " & accessObj.GetOption("ANSI Query Mode") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:SQL サーバー互換構文 (ANSI 92)、 新しいデータベースの標準/SQL Server Compatible Syntax (ANSI 92), Default for new databases = " & accessObj.GetOption("ANSI Query Mode Default") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:クエリ デザインのフォント、 フォント/Query design font, Font = " & accessObj.GetOption("Query Design Font Name") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[クエリ デザイン] セクション:クエリ デザインのフォント、 サイズ/Query design font, Size = " & accessObj.GetOption("Query Design Font Size") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[フォーム/レポート] セクション:ドラッグによるコントロールの選択/Selection behavior = " & accessObj.GetOption("Selection Behavior") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[フォーム/レポート] セクション:フォーム テンプレート/Form template = " & accessObj.GetOption("Form Template") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[フォーム/レポート] セクション:レポート テンプレート/Report template = " & accessObj.GetOption("Report Template") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[フォーム/レポート] セクション:常にイベント プロシージャを使用する/Always use event procedures = " & accessObj.GetOption("Always Use Event Procedures") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:エラー チェックを行う/Enable error checking = " & accessObj.GetOption("Enable Error Checking") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:エラー インジケーターの表示色/Error indicator color = " & accessObj.GetOption("Error Checking Indicator Color") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:関連付けられていないラベルとコントロールをチェックする/Check for unassociated label and control = " & accessObj.GetOption("Unassociated Label and Control Error Checking") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:関連付けられていない新しいラベルをチェックする/Check for new unassociated labels = " & accessObj.GetOption("New Unassociated Labels Error Checking") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:ショートカット キーのエラーをチェックする/Check for keyboard shortcut errors = " & accessObj.GetOption("Keyboard Shortcut Errors Error Checking") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:無効なコントロール プロパティをチェックする/Check for invalid control properties = " & accessObj.GetOption("Invalid Control Properties Error Checking") & vbCrLf , 0
sr.WriteText "[オブジェクト デザイナー] タブ:[エラー チェック] セクション:一般的なレポートのエラーをチェックする/Check for common report errors = " & accessObj.GetOption("Common Report Errors Error Checking") & vbCrLf , 0
sr.WriteText "[文章校正] タブ:[Microsoft Office プログラムのスペル チェック] セクション:すべて大文字の単語は無視する/Ignore words in UPPERCASE = " & accessObj.GetOption("Spelling ignore words in UPPERCASE") & vbCrLf , 0
sr.WriteText "[文章校正] タブ:[Microsoft Office プログラムのスペル チェック] セクション:数字を含む単語は無視する/Ignore words that contain numbers = " & accessObj.GetOption("Spelling ignore words with number") & vbCrLf , 0
sr.WriteText "[文章校正] タブ:[Microsoft Office プログラムのスペル チェック] セクション:インターネット アドレスとファイル パスは無視する/Ignore Internet and file addresses = " & accessObj.GetOption("Spelling ignore Internet and file addresses") & vbCrLf , 0
sr.WriteText "[文章校正] タブ:[Microsoft Office プログラムのスペル チェック] セクション:メイン辞書のみ使用する/Suggest from main dictionary only = " & accessObj.GetOption("Spelling suggest from main dictionary only") & vbCrLf , 0
sr.WriteText "[文章校正] タブ:[Microsoft Office プログラムのスペル チェック] セクション:辞書の言語/Dictionary Language = " & accessObj.GetOption("Spelling dictionary language") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:Enter キー入力後の動作/Move after enter = " & accessObj.GetOption("Move After Enter") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:フィールド移動時の動作/Behavior entering field = " & accessObj.GetOption("Behavior Entering Field") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:方向キーの動作/Arrow key behavior = " & accessObj.GetOption("Arrow Key Behavior") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:先頭/最後のフィールドでカーソルを止める/Cursor stops at first/last field = " & accessObj.GetOption("Cursor Stops at First/Last Field") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:既定の検索/置換/Default find/replace behavior = " & accessObj.GetOption("Default Find/Replace Behavior") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:確認、 レコードの変更/Confirm, Record changes = " & accessObj.GetOption("Confirm Record Changes") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:確認、 オブジェクトの削除/Confirm, Document deletions = " & accessObj.GetOption("Confirm Document Deletions") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:確認、 アクション クエリ/Confirm, Action queries = " & accessObj.GetOption("Confirm Action Queries") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:既定の方向/Default direction = " & accessObj.GetOption("Default Direction") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:通常の並び順/General alignment = " & accessObj.GetOption("General Alignment") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:カーソル移動/Cursor movement = " & accessObj.GetOption("Cursor Movement") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:データシート上で IME を制御する/Datasheet IME control = " & accessObj.GetOption("Datasheet Ime Control") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[編集] セクション:イスラム暦を使用する/Use Hijri Calendar = " & accessObj.GetOption("Use Hijri Calendar") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:最近使用したドキュメントの一覧に表示するドキュメントの数/Show this number of Recent Documents = " & accessObj.GetOption("Size of MRU File List") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:ステータス バー/Status bar = " & accessObj.GetOption("Show Status Bar") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:行や列をスライド表示する/Show animations = " & accessObj.GetOption("Show Animations") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:スマート タグをデータシートに表示する/Show Smart Tags on Datasheets = " & accessObj.GetOption("Show Smart Tags on Datasheets") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:スマート タグをフォームとレポートに表示する/Show Smart Tags on Forms and Reports = " & accessObj.GetOption("Show Smart Tags on Forms and Reports") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:マクロ デザイン、 マクロ名/Show in Macro Design, Names column = " & accessObj.GetOption("Show Macro Names Column") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[表示] セクション:マクロ デザイン、 条件/Show in Macro Design, Conditions column = " & accessObj.GetOption("Show Conditions Column") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[印刷] セクション:左余白/Left margin = " & accessObj.GetOption("Left Margin") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[印刷] セクション:右余白/Right margin = " & accessObj.GetOption("Right Margin") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[印刷] セクション:上余白/Top margin = " & accessObj.GetOption("Top Margin") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[印刷] セクション:下余白/Bottom margin = " & accessObj.GetOption("Bottom Margin") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[全般] セクション:操作の結果を音で知らせる/Provide feedback with sound = " & accessObj.GetOption("Provide Feedback with Sound") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[全般] セクション:4 桁での年表示、 このデータベース/Use four-year digit year formatting, This database = " & accessObj.GetOption("Four-Digit Year Formatting") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[全般] セクション:4 桁での年表示、 すべてのデータベース/Use four-year digit year formatting, All databases = " & accessObj.GetOption("Four-Digit Year Formatting All Databases") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:Access の起動時に、前回使用したデータベースを開く/Open last used database when Access starts = " & accessObj.GetOption("Open Last Used Database When Access Starts") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:既定の開くモード/Default open mode = " & accessObj.GetOption("Default Open Mode for Databases") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:既定のレコード ロック/Default record locking = " & accessObj.GetOption("Default Record Locking") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:レコード レベルでロックして開く/Open databases by using record-level locking = " & accessObj.GetOption("Use Row Level Locking") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:OLE/DDE タイムアウト (秒)/OLE/DDE timeout (sec) = " & accessObj.GetOption("OLE/DDE Timeout (sec)") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:再表示の間隔 (秒)/Refresh interval (sec) = " & accessObj.GetOption("Refresh Interval (sec)") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:更新の回数/Number of update retries = " & accessObj.GetOption("Number of Update Retries") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:ODBC の再表示の間隔 (秒)/ODBC refresh interval (sec) = " & accessObj.GetOption("ODBC Refresh Interval (sec)") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:更新の間隔 (ミリ秒)/Update retry interval (msec) = " & accessObj.GetOption("Update Retry Interval (msec)") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:DDE 操作、 DDE 要求を無視/DDE operations, Ignore DDE requests = " & accessObj.GetOption("Ignore DDE Requests") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:DDE 操作、 DDE 更新を有効にする/DDE operations, Enable DDE refresh = " & accessObj.GetOption("Enable DDE Refresh") & vbCrLf , 0
sr.WriteText "[詳細設定] タブ:[詳細設定] セクション:コマンド ライン引数/Command-line arguments = " & accessObj.GetOption("Command-Line Arguments") & vbCrLf , 0
sr.SaveToFile outFolder.Path & "\" & "AccessGetOption_" & "Utf8.txt", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
'//////////////////////////////////////////////////////////////////////////////////////////////////////////
'''' Make Reference List. -[VBS]--------------------------------------------------------------------
sr.Mode = 3 '読み取り/書き込みモード'270>378
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
On Error Resume Next
sr.WriteText "ref.Name" & "," & "ref.FullPath" & "," & "ref.BuiltIn" & "," & "ref.GUID" & "," & "ref.Major" & "," & "ref.Minor" & "," & "ref.IsBroken" & vbCrLf, 0
For Each ref In accessObj.VBE.ActiveVBProject.References
If ref.IsBroken = False Then
sr.WriteText ref.Name & "," & ref.FullPath & "," & ref.BuiltIn & "," & ref.GUID & "," & ref.Major & "," & ref.Minor & "," & ref.IsBroken & vbCrLf, 0
Else
sr.WriteText ref.Name & " is broken" & vbCrLf, 0
End If
If Err.Number <> 0 Then Err.Clear
Next
sr.SaveToFile outFolder.Path & "\" & "VBAReferenceList_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
'''' Make DataBase Properties List. -[VBS]---------------------

sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
On Error Resume Next
For Each p In cDB.Properties
sr.WriteText """" & cDB.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, adWriteChar '0:adWriteChar
If Err.Number <> 0 Then Err.Clear
Next
sr.SaveToFile outFolder.Path & "\" & "DataBaseProperties_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
On Error GoTo 0
'''''''' [[[[ END ]]]] Make DataBase Properties List. -[VBS]----
'''' Make Table And ReportForm List. -[VBS]--------------------------------------------------------------------
'Set objColl = accessObj.CurrentData.AllTables
If accessObj.CurrentData.AllTables.Count > 0 Then
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
buf = "name,fullname,Type,IsWeb,IsLoaded,DateCreated,DateLastModified" & vbCrLf
sr.WriteText buf, 0 '0:adWriteChar
For i = accessObj.CurrentData.AllTables.Count -1 to 0 Step -1
set obj = accessObj.CurrentData.AllTables.Item(i)
buf = obj.Name & "," & obj.FullName & "," & obj.Type & "," & obj.IsWeb & "," & obj.IsLoaded & "," & obj.DateCreated & "," & obj.DateModified & vbCrLf
sr.WriteText buf, adWriteChar '0:adWriteChar
Next
sr.SaveToFile outFolder.Path & "\" & "tableList_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
End If
'''' Report And Form List. -[VBS]---------------------------
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
sr.WriteText "-----AllForms List----" & vbCrlf
If accessObj.CurrentProject.AllForms.Count > 0 Then
For i = accessObj.CurrentProject.AllForms.Count - 1 To 0 Step -1
Set obj = AccessObj.CurrentProject.AllForms.Item(i)
sr.WriteText obj.Name, 0
Next
Else
sr.WriteText "No Forms" , 0
End If
sr.WriteText "-----AllForms List----" & vbCrlf
If accessObj.CurrentProject.AllReports.Count > 0 Then
For i = accessObj.CurrentProject.AllReports.Count - 1 To 0 Step -1
Set obj = accessObj.CurrentProject.AllReports.Item(i)
sr.WriteText obj.Name, 0
Next
Else
sr.WriteText "No Reprts" , 0
End If
sr.SaveToFile outFolder.Path & "\" & "ReportAndFormList_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
On Error GoTo 0
If accessObj.CurrentData.AllTables.Count > 0 Then
Set objColl = accessObj.CurrentData.AllTables
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
buf = "name,fullname,Type,IsWeb,IsLoaded,DateCreated,DateLastModified" & vbCrLf
sr.WriteText buf, 0 '0:adWriteChar
For Each obj In objColl
buf = obj.Name & "," & obj.FullName & "," & obj.Type & "," & obj.IsWeb & "," & obj.IsLoaded & "," & obj.DateCreated & "," & obj.DateModified & vbCrLf
sr.WriteText buf, adWriteChar '0:adWriteChar
Next
sr.SaveToFile outFolder.Path & "\" & "tableList_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
End If
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
sr.WriteText "ReportAndFormList", 0
IF accessObj.CurrentProject.AllForms.Count > 0 Then
For Each v In accessObj.CurrentProject.AllForms
sr.WriteText v.Name & ":作成日時" & v.DateCreated & ":更新日時" & v.DateModified & ":フルネーム" & v.FullName & ":開いているか" & v.IsLoaded & ":ウェブ対応か" & v.IsWeb & ":タイプ(フォームは2)" & v.Type, 0
Next
End If
IF accessObj.CurrentProject.AllReports.Count > 0 Then
For Each v In accessObj.CurrentProject.AllReports
sr.WriteText v.Name & ":作成日時" & v.DateCreated & ":更新日時" & v.DateModified & ":フルネーム" & v.FullName & ":開いているか" & v.IsLoaded & ":ウェブ対応か" & v.IsWeb & ":タイプ(レポートは3)" & v.Type, 0
Next
End iF
sr.SaveToFile outFolder.Path & "\" & "ReportAndFormList_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
On Error GoTo 0
'''''''' [[[[ END ]]]] Make Table List. -[VBS]-----------------------

'''' Import Export Specification -[VBS]------------------------------------------------------------------
'''''''' Make IMEX List. -[VBS]------------------------------------------------------------------------------
On Error Resume Next
If accessObj.CurrentProject.ImportExportSpecifications.Count > 0 Then
If Err.Number = 0 Then
Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & "AllImportExportSpecification.txt")
Set imexObjs = accessObj.CurrentProject.ImportExportSpecifications
For Each imexObj In imexObjs
If Err.Number <> 0 Then
oSQL.Write imexObj.Name & vbCrLf
Err.Clear
Else
oSQL.Write imexObj.Name & vbCrLf & imexObj.Description & vbCrLf
End If
Next
oSQL.Close
Set imexObjs = Nothing
End If
End If
'''''''' [[ END ]] Import Export Specification -[VBS]---------[VBS]------------------------------------------------------------------
'''' All Object Name and ConnectionString List. -[VBS]-------
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
For Each v In cDB.TableDefs
sr.WriteText "Table : " & v.Name & vbCrLf, 0
If LCase(Left(v.Name, 4)) = "msys" Then accessObj.ExportXml acExportTable, v.Name, rFol & "TbX_" & v.Name & "utf8.xml", rFol & "TbX_" & v.Name & "utf8.xsd", rFol & "TbX_" & v.Name & "utf8.xsl", rFol & "\IMG"
Next
'On Error Resume Next
For Each v In cDB.QueryDefs
sr.WriteText "Query : " & v.Name & vbCrLf, 0
If v.Parameters = 0 Then
If v.Type = dbQSelect Or v.Type = dbQCrosstab Then accessObj.ExportXml acExportQuery, v.Name, rFol & "QrX_" & v.Name & "utf8.xml", rFol & "QrX_" & v.Name & "utf8.xsd", rFol & "QrX_" & v.Name & "utf8.xsl", rFol & "\IMG", acUTF8 '選択クエリ、ユニオンクエリ、クロス集計クエリを出力
End If
Next
If Err.Number <> 0 Then Err.Clear
For Each v In accessObj.Application.CurrentProject.AllForms 'フォームの出力 スキーマに限る
If v.IsLoaded = True Then accessObj.Application.DoCmd.Close acForm, v.Name, acSaveNo
sr.WriteText "Form : " & v.Name & vbCrLf, 0
'If blTableBackUpMode = True And hasParameter = False Then
'accessObj.ExportXml acExportForm, v.Name ,outFolder.Path & "\" & "Frm_" & v.name & "utf8.xml", outFolder.Path & "\" & "Frm_" & v.Name & "utf8.xsd", outFolder.Path & "\" & "Frm_" & v.name & "utf8.xsl",rFol & "\IMG"
'ElseIf blTableBackUpMode = False And hasParameter = False Then
'accessObj.ExportXML acExportForm, v.Name, , outFolder.Path & "\" & "Frm_" & v.Name & "utf8.xsd", outFolder.Path & "\" & "Frm_" & v.name & "utf8.xsl",rFol & "\IMG"
'End IF
'accessObj.ExportXml acExportForm, v.Name ,,, outFolder.Path & "\" & "Frm_" & v.name & "utf8.xsl"
Next
For Each v In accessObj.Application.CurrentProject.AllReports
If v.IsLoaded = True Then accessObj.Application.DoCmd.Close acReport, v.Name, acSaveNo
sr.WriteText "Reports : " & v.Name & vbCrLf, 0
'On Error GoTo 0
If blTableBackUpMode And hasParameter = False Then
accessObj.ExportXml acExportReport, v.Name, rFol & "ReX_" & v.Name & "utf8.xml", rFol & "ReX_" & v.Name & "utf8.xsd", outFolder.Path & "\" & "ReX_" & v.Name & "utf8.xsl", outFolder.Path & "\IMG"
ElseIf blTableBackUpMode = False And hasParameter = False Then
accessObj.ExportXml acExportReport, v.Name, , rFol & "ReX_" & v.Name & "utf8.xsd", rFol & "ReX_" & v.Name & "utf8.xsl", rFol & "\IMG"
End If
Next
For Each v In accessObj.CurrentProject.AllMacros
sr.WriteText "Macro : " & v.Name & vbCrLf, 0
Next
For Each v In accessObj.CurrentProject.AllModules
sr.WriteText "Module : " & v.Name & vbCrLf, 0
Next
sr.WriteText "AccessConnection " & accessObj.CurrentProject.AccessConnection & vbCrLf
sr.WriteText "BaseConnectionString " & accessObj.CurrentProject.BaseConnectionString & vbCrLf
sr.SaveToFile outFolder.Path & "\" & "AllObjName_CNStrList_" & "Utf8.txt", 2 '2:adSaveCreateOverWrite
sr.Close: oLog.Write "Line 553 DataBase Properties List Completed" & vbCrLf 'Streamを閉じる
If Err.Number <> 0 Then oLog.Write "Line 554: Err.Number " & Err.Number & ":" & Err.Description: Err.Clear
On Error GoTo 0
'''' Make Each Table Properties List. -[VBS]-------------------------
Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & "LinkTable_Information.txt"):oLog.Write "Line 430 Make Each Table Properties List" & vbCrLf
For Each tdf In cDB.TableDefs
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
On Error Resume Next
'''' Export Xml. ---[VBS]--------- Const blTableBackUpMode = True is All Table ExportXml
If blTableBackUpMode = True Then
If LCase(Left(tdf.Name, 4)) <> "msys" Then accessObj.ExportXml acExportTable, tdf.Name, rFol & "TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xml", _
rFol & "TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xsd", _
rFol & "TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xsl", _
rFol & "\IMG"
Else
If LCase(Left(tdf.Name, 4)) <> "msys" Then accessObj.ExportXml acExportTable, tdf.Name, , rFol & "TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xsd", _
rFol & "TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xsl", _
rFol & "\IMG"
End If
'''''''' [[End]] Export Xml. -------------------------------------------
'''''''' Make LinkTableInfo. -[VBS]-------------------------------------
If tdf.Attributes And accessObj.dbAttachedODBC Then
If tdf.Indexes.Count > 0 Then
For Each idx In tdf.Indexes
oSQL.Write """" & tdf.Name & """" & "," & tdf.Indexes.Count & "," & idx.Name & "," & idx.Primary & "," & idx.Unique & vbCrLf
Next
Else
oSQL.Write """" & tdf.Name & """" & "," & """" & "No Index" & """" & vbCrLf
End If
End If
If tdf.Attributes And accessObj.dbAttachedODBC Then
If tdf.Indexes.Count > 0 Then
CNT = 0:oLog.Write "Line 588 Make LinkTableInfo"
For Each idx In tdf.Indexes
If CNT = 0 Then oSQL.Write "Table Name" & "," & "Indexes.count" & "," & "idx.name" & "," & "IsPrimary" & "," & "IsUniQue" & vbCrLf: CNT = CNT + 1
oSQL.Write """" & tdf.Name & """" & "," & tdf.Indexes.Count & "," & idx.Name & "," & idx.Primary & "," & idx.Unique & vbCrLf
Next
Else
oSQL.Write """" & tdf.Name & """" & "," & """" & "No Index" & """" & vbCrLf
End If
End If
'''''''' [[End]] Make LinkTableInfo. -[VBS]-------------------------------------
On Error Resume Next:oSQL.Write "Line 598 Start" & vbCrLf
For Each p In tdf.Properties
sr.WriteText tdf.Name & "," & p.Name & "," & p.Value & "," & p.Type & "," & p.Inherited & vbCrLf, 0
If Err.Number <> 0 Then oLog.Write "Line 601 " & Err.Number & Err.Description & vbCrLf : Err.Clear
Next
Set flds = tdf.Fields

For Each fld In tdf.Fields

For Each p In fld.Properties
sr.WriteText tdf.Name & "," & fld.Name & "," & fld.Type & "," & " Fields.prop" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
If Err.Number <> 0 Then oLog.Write "Line 609 " & tdf.name & ":" & fld.Name & ":" & p.Name & ":" & Err.Number & Err.Description & vbCrLf : Err.Clear
Next
Next
sr.SaveToFile outFolder.Path & "\" & tdf.Name & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close
Next
oSQL.Close: Set oSQL = Nothing
oLog.Write "Line 616 :Make Query List" & vbCrLf '''' Make Query List. -[VBS]-------------------------------------------
On Error Resume Next
For Each Q In cDB.QueryDefs
' SQL Statement Output to UniCode File
Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & Replace(Replace(Q.Name, "~", "_", 1, -1), "/", "_", 1, -1) & "_SQL.txt")
sSQL = Q.Sql
oSQL.Write sSQL
oSQL.Close
Set oSQL = Nothing
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
For Each p In Q.Properties
'On Error Resume Next
sr.WriteText """" & Q.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
If Err.Number <> 0 Then oLog.Write "line 632 "& Q.Name & ":" & p.Name & ":" & err.number & Err.Description & vbCrLf: Err.Clear
'On error Goto 0 'Debug.Print """" & Q.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """"
Next
Set flds = Q.Fields
For Each fld In Q.Fields
For Each p In fld.Properties
sr.WriteText """" & Q.Name & """" & "," & """" & fld.Name & """" & "," & """" & fld.Type & """" & "," & """" & " Fields.prop" & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
If Err.Number <> 0 Then oLog.Write "line 639 " & Q.Name & ":" & fld.name & ":" & err.number & Err.Description & vbCrLf :Err.Clear
'Debug.Print """" & Q.Name & """" & "," & """" & fld.Name & """" & "," & """" & fld.Type & """" & "," & """" & " Fields.prop" & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """"
Next
Next
sr.SaveToFile outFolder.Path & "\" & Q.Name & "Utf8.csv", 2 '2:adSaveCreateOverWrite
sr.Close 'Streamを閉じる
Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
Ext = "": Ext = ".qry":oLog.Write "Line 649 Query" & vbCrLF
Set objColl = accessObj.CurrentData.AllQueries
For Each obj In objColl
FilePath = outFolder.Path & "\" & obj.Name & Ext
accessObj.SaveAsText acQuery, obj.Name, FilePath
If Err.Number <> 0 Then oLog.Write "Line 654" & Err.Number & ";" & Err.Description & vbCrLf: Err.Clear
Next
Set objColl = Nothing
Set objColl = accessObj.CurrentProject.AllReports
Ext = "": Ext = ".rpt"
For Each obj In objColl
FilePath = outFolder.Path & "\" & obj.Name & Ext
accessObj.SaveAsText acReport, obj.Name, FilePath
If Err.Number <> 0 Then oLog.Write "Line 662" & Err.Number & ";" & Err.Description & vbCrLf: Err.Clear
Next
Set objColl = Nothing: oLog.Write "Line 664" & vbCrLf
Set objColl = accessObj.CurrentProject.AllMacros
Ext = "": Ext = ".mcr"
For Each obj In objColl
FilePath = outFolder.Path & "\" & obj.Name & Ext
accessObj.SaveAsText acMacro, obj.Name, FilePath
If Err.Number <> 0 Then oLog.Write "Line 670" & Err.Number & ";" & Err.Description & vbCrLf: Err.Clear
Next
Set objColl = Nothing: oLog.Write "Line 672" & vbCrLf
Set objColl = accessObj.CurrentProject.AllForms
Ext = "": Ext = ".frm"
For Each obj In objColl
'If hasParameter = False Then
FilePath = outFolder.Path & "\" & obj.Name & Ext
accessObj.SaveAsText acForm, obj.Name, FilePath
'End If
If Err.Number <> 0 Then oLog.Write "Line 680" & Err.Number & ";" & Err.Description & vbCrLf: Err.Clear
Next
Set objColl = Nothing

''''' Container Object. -[VBS]------------------------------------------------------------
'Access 2013 Later

On Error Resume Next
If CInt(accessObj.Application.Version) >= 15 Then
sr.Mode = 3 '読み取り/書き込みモード
sr.Type = 2 'テキストデータ
sr.Charset = "UTF-8" '文字コードを指定
sr.Open 'Streamオブジェクトを開く
With cDB
' Enumerate Containers collection.
For Each ctrLoop In .Containers
sr.WriteText "Properties of " & ctrLoop.Name _
& " container"

' Enumerate Properties collection of each
' Container Object.
For Each prpLoop In ctrLoop.Properties
sr.WriteTextt " " & prpLoop.Name _
& " = " & prpLoop
Next 'prpLoop

Next 'ctrLoop
End With
sr.SaveToFile outFolder.Path & "\" & "AllContainerProperty_" & "Utf8.txt", 2 '2:adSaveCreateOverWrite
End If
oLog.Write "Line 710:accdb/mdb Q.SQL" & vbCrLf ''''' accdb/mdb Q.SQL UTf8 -[VBS]------------------------------------------------------------
For Each Q In cdb.QueryDefs
sr.Open
Debug.Print Q.Name, Q.SQL
sr.WriteText Q.SQL
sr.SaveToFile outFolder.Path & "\SQLU8Txt_" & Replace(Replace(Q.Name, "/", "_", 1, -1, vbTextCompare), "~", "_", 1, -1, vbTextCompare) & ".txt"
sr.Close
Next
''''' accdb/mdbを閉じる. -[VBS]------------------------------------------------------------
'If blVisible = True Then accessObj.Quit() 'VBA accessObj.Quit
accessObj.CloseCurrentDatabase
On Error GoTo 0
'''' Compact Database Option (32 bit) -[VBS]------------------------------------------------------------

If Err.Number <> 0 Then oLog.Write Err.Number & "," & Err.Description & " Line 724" & vbCrLf: Err.Clear
On Error Resume Next
If MsgBox("最適化しますか?(32bitAccess Only)", vbInformation + vbYesNo, "CompactDataBase ? ") = vbYes Then
strDestination = rFol & fs.GetBasename(inFileName) & "_compactrepair." & fs.GetExtensionName(inFileName)
v = accessObj.Application.Compactrepair(inFileName, strDestination, True)
oLog.Write "start: accessobj.application.CompactRepair" & " inFileName :=" & inFileName & " DestinationFile:=" & strDestination & " Result:= " & v
If Err.Number <> 0 Then oLog.Write Err.Number & "," & Err.Description & " Line 730" & vbCrLf
If v <> True Or Err.Number <> 0 Then
Dim WSH: Set WSH = CreateObject("WScript.shell")
With WSH
'If Wscript.Arguments.Count > 0 Then
If inFileName <> "" Then
.Run "cmd.exe /c " & """" & inFileName & """" & " /repair", 0
End If
End With
Set WSH = Nothing
WScript.Sleep 2000
End If
End If

'''' [[ End ]] Compact Database Option (32 bit) -----------------------------------------------------------------
accessObj.Quit (acQuitSaveNone) 'VBA accessObj.Quit
Set accessObj = Nothing:oLog.Write "Line 746 Export database Complete"
MsgBox "完了しました"

'''' Export System Information. -[VBS]---------------------------------------------------
With CreateObject("WScript.shell")
If fs.FileExists(outFolder.Path & "\" & "SystemInfo.Csv") Then fs.DeleteFile outFolder.Path & "\" & "SystemInfo.Csv"
If fs.FileExists(outFolder.Path & "\" & "EnvironmentVariable.txt") Then fs.DeleteFile outFolder.Path & "\" & "EnvironmentVariable.txt"
cmdStr = "Cmd.Exe /c " & """" & "SystemInfo /FO CSV>"
cmdStr = cmdStr & outFolder.Path & "\" & "SystemInfo.Csv" & """"
.Run cmdStr, 0 : oLog.Write "Line 755 Export System Infomation" & vbCrLf
cmdStr = ""
cmdStr = "Cmd.Exe /c " & """" & "Set >"
cmdStr = cmdStr & outFolder.Path & "\" & "EnvironmentVariable.txt" & """"
.Run cmdStr, 0
End With

' Make File List.-[VBS]------------------------------------------------
'''' Make File List.-[VBS]------------------------------------------------
Set oSQL = fs.CreateTextFile(outFolder.Path & "\FSOAccessObjectExPortFileList.txt", True, True)
For Each oFile In outFolder.Files
oSQL.WriteLine """" & oFile.Name & """" & "," & fs.GetExtensionName(oFile.Path)
Next
oSQL.Close
oLog.Write "olog.Close" & cstr(now) & vbCrlf :oLog.Close
Set oLog = Nothing
Set oSQL = Nothing
Set fs = Nothing
Set sr = Nothing

#このVBScriptの必要性とすごさ

Accessの全オブジェクトをテキストとしてバックアップが可能になった

AccessのVBAには独特のマクロがあります。これはコードを書かなくても選択するだけで自動的に作業を処理するプログラムができてしまうものです。（以下Access独特のマクロといいます）
しかし、公式にはこのAccess独特のマクロは別のAccessのファイルにしか移行できず、簡単な癖にバックアップが難しいというものでした。
しかし、この開発によってAccess独特のマクロも一括してテキストファイルに出力できました。
つまりほぼすべてのオブジェクトをテキスト形式に出力できるようになったわけです。
なお戻すときはApplication.LoadfromTextという隠し命令をつかいます。

Accdbでもmdbでも64/32でも使える(最適化オプションを除く)

このプログラム自体は
AccessのVBAソースを一括エクスポートする
というところにあったものです。2009年に作られました。またMDBを想定しています。
このころまではMDBが主流だったのですね...
このVbscriptはWindows 10 Access 64 bit Accdbで動作を確かめて強化しました。
つまりMDBでもAccdbでもどちらでも使えます。
この辺は従前、記事にしています。
MS Access 2013 Later can Open mdb file

特に注目すべき点

まず参照設定をVBSで扱えるというのはすごいですね。
またSaveasText命令をVBSでも使えているところです。

VBA版

相違点

VBA版は64/32が混在するため、最適化オプションはありません
現在のバージョンは遅延バインディングしているため、Accesss Excel Word どれでも動きます。
また、ファイル名はドラッグアンドドロップではなく、infilenameで指定しています。
http://techbank.jp/Community/blogs/mymio/archive/2009/01/22/4480.aspx
はデッドリンクですが、文脈からするとVBA版が載せられていたものと推量されます。

AllAccessObjectExt()
Option Explicit
' http://techbank.jp/Community/blogs/mymio/archive/2009/01/22/4480.aspxを改良(?)
' --------------------------------------------------------------------------------
' For VBA
' --------------------------------------------------------------------------------
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'-----------------------------------------------------------------
' 定数
'-----------------------------------------------------------------

'Dim vbext_ct_ClassModule, vbext_ct_Document, vbext_ct_MSForm, vbext_ct_StdModule
    Const vbext_ct_ClassModule = 2
    Const vbext_ct_Document = 100
    Const vbext_ct_MSForm = 3
    Const vbext_ct_StdModule = 1
'''''''' Access.AcObjectType
    Const acQuery = 1
    Const acReport = 3
    Const acModule = 5
    Const acMacro = 4
    Const acDatabaseProperties = 11
    Const acDiagram = 8
    Const acFunction = 10
    Const acTable = 0

'''''''' ADODB.Stream
    Const adWriteChar = 0
    Const adWriteLine = 1
    Const adTypeText = 2
    Const adTypeBinary = 1

'''''''''Access.Apllicastin Syscmd AcSysCmdAction 列挙
    Const acSysCmdClearStatus = 5
    Const acSysCmdAccessDir = 9
    Const acSysCmdGetWorkgroupFile = 13
    Const acSysCmdIniFile = 8
    Const acSysCmdProfile = 12
    Const acSysCmdRuntime = 6
    Const acSysCmdAccessVer = 7
'''''''' Access.AcImportXMLOption
    Const acAppendData = 2
    Const acStructureOnly = 0 'テーブルの構造のみ
    Const acStructureAndData = 1
'''''''' Access.AcExportXMLObjectType
    Const acExportTable = 0
    Const acExportForm = 2
    Const acExportFunction = 10
    Const acExportQuery = 1
    Const acExportReport = 3
    Const acExportServerView = 7
    Const acExportStoredProcedure = 9
''''''''  DAO.TableDefAttributeEnum
    Const dbSystemObject = -2147483646
    Const dbHiddenObject = 1
'''''''' Access.AcDataTransferType
    Const acExport = 1
    Const acUTF8 = 0
'''''''' 
    Const acExportAllTableAndFieldProperties = 32
    Const acPersistReportML = 16
    Const acEmbedSchema = 1
'''''''' DAO.QueryDefTypeEnum
    Const dbQSetOperation = 128
    Const dbQSelect = 0
    Const dbQCrosstab = 16
'''''''' Special BackUp Option
    Const blVisible = False 'Falseの時バックグラウンドで開く
    Const blTableBackUpMode = False 'テーブル/レポートのデータをXML形式でバックアップします。テーブルが大きいとバックアップ容量、時間がかかるので通常はFalseにしてください。
'-----------------------------------------------------------------
' 変数宣言
'-----------------------------------------------------------------    
    Dim inFileName, fs, inFile, outPath, outFolder
    Dim accessObj, vbproject, vbcComp, moduleName, cDB, cProj
    Dim FilePath, Ext, objColl, obj, sr, str, buf
    Dim prop, tdf, tdfName, fld, flds, fldp, p, ref, Q, sSQL, oSQL, oFile, vBuffer, cmdStr , v, idx, CNT, rFol
' --------------------------------------------------------------------------------
' メイン
' --------------------------------------------------------------------------------

Set fs = CreateObject("Scripting.FileSystemObject")
Set inFile = fs.GetFile(inFileName)
outPath = inFile.ParentFolder.Path & "\" & Replace(inFile.Name, ".", "_", 1, -1) & "_text"

' 出力フォルダが存在していれば消して作り直す
    If fs.FolderExists(outPath) Then
        fs.DeleteFolder outPath,True
    End If
    WScript.Sleep 1000 'In Case VBA WScript.Sleep >>> Sleep
    fs.CreateFolder(outPath)
    WScript.Sleep 500  'In Case VBA WScript.Sleep >>> Sleep
    fs.CreateFolder(outPath & "\IMG") :WScript.Sleep 500 'In Case VBA WScript.Sleep >>> Sleep
    Set outFolder = fs.GetFolder(outPath) : rFol = outFolder.Path & "\" 
'''' Accessを起動し、バージョン情報を記録する. --------------------------------------------
On Error Resume Next
'''''''' accdb/mdbを開く. -----------------------------------------------------------------
    Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & "AccsessVersionInfo.txt")
    Set accessObj = CreateObject("Access.Application")
    accessObj.OpenCurrentDatabase (inFileName)
        If blVisible = True Then accessObj.Visible = True : accessObj.UserControl = True
    Set cDB = accessObj.CurrentDb
'Ser cProj = AccessObj.CurrentProject
'''''''' 情報の記録. -------------------------------------------------------------------------------
       oSQL.Write accessObj.SysCmd(acSysCmdAccessDir) & " にバージョン " & _
       accessObj.Version & " がインストールされています." & vbCrLf
       oSQL.Write "以下は該当がないときは左には何も表示されていません," & vbCrLf & _
       accessObj.SysCmd(acSysCmdIniFile) & " ;iniファイルがあれば左に場所が示されます. (acSysCmdIniFile) " & vbCrLf & _
       accessObj.SysCmd(acSysCmdClearStatus) & " :左にデータベース オブジェクトの状態についての情報を提供します. (acSysCmdClearStatus) " & vbCrLf & _
       accessObj.SysCmd(acSysCmdRuntime) & " :左にAccess のランタイム バージョンが実行されている場合は、True(-1) を返します. (acSysCmdRuntime) " & vbCrLf & _
       accessObj.SysCmd(acSysCmdGetWorkgroupFile) & " :左にワークグループ ファイル (System.mdw) のパスを返します. (acSysCmdGetWorkgroupFile) " & vbCrLf & _
       accessObj.SysCmd(acSysCmdProfile) & " :左にAccess をコマンド ラインから起動するときに指定した /profile の返します. (acSysCmdProfile) "
       oSQL.Close
       Set oSQL = Nothing
'''' モジュールをテキスト化. ----------------------------------------------------------------------------------------
    Set vbproject = accessObj.VBE.ActiveVBProject
    For Each vbcComp In vbproject.VBComponents
        Select Case vbcComp.Type
        Case vbext_ct_Document, vbext_ct_StdModule
            Ext = ".bas"
        Case vbext_ct_ClassModule
            Ext = ".cls"
        Case vbext_ct_MSForm
            Ext = ".frm"
        Case Else
            Ext = ""
        End Select
       ' Accessでは、「/」 入りのモジュール名を作成することができるが
       ' モジュールファイルをエクスポートするとOSの問題で、
       ' 「/」入りのファイル名を保存することができない
       ' そのため、「/」文字を「_」に変換してエクスポートする
        moduleName = Replace(vbcComp.Name, "/", "_")
        vbcComp.Export (outFolder.Path & "\" & moduleName & Ext)
    Next


'''' ADODB Stream Variable Set !!!! ---------------------------------------------
    Set sr = CreateObject("ADODB.Stream") 'For Makeing UTF-8 text file (with BOM)
'''' [[ End ]] ADODB Stream Variable Set !!!!---------------------------------------------

    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
    On Error Resume Next
    sr.WriteText "ref.Name" & "," & "ref.FullPath" & "," & "ref.BuiltIn" & "," & "ref.GUID" & "," & "ref.Major" & "," & "ref.Minor" & "," & "ref.IsBroken" & vbCrLf, 0
'''' Make Reference List. --------------------------------------------------------------------------
    For Each ref In accessObj.VBE.ActiveVBProject.References
        If ref.IsBroken = False Then
        sr.WriteText ref.Name & "," & ref.FullPath & "," & ref.BuiltIn & "," & ref.Guid & "," & ref.Major & "," & ref.Minor & "," & ref.IsBroken & vbCrLf, 0
        Else
        sr.WriteText ref.Name & " is broken" & vbCrLf, 0
        End If
    If Err.Number <> 0 Then Err.Clear
    Next
    sr.SaveToFile outFolder.Path & "\" & "VBAReferenceList_" & "Utf8.csv", 2   '2:adSaveCreateOverWrite
    sr.Close 'Streamを閉じる
'''' Make Table List. --------------------------------------------------------------------------
    Set objColl = accessObj.CurrentData.AllTables
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
    buf = "name,fullname,Type,IsWeb,IsLoaded,DateCreated,DateLastModified" & vbCrLf
    sr.WriteText buf, 0 '0:adWriteChar
    For Each obj In objColl
    buf = obj.Name & "," & obj.FullName & "," & obj.Type & "," & obj.IsWeb & "," & obj.IsLoaded & "," & obj.DateCreated & "," & obj.DateModified & vbCrLf
    sr.WriteText buf, adWriteChar '0:adWriteChar
    Next
    sr.SaveToFile outFolder.Path & "\" & "tableList_" & "Utf8.csv", 2   '2:adSaveCreateOverWrite
    sr.Close 'Streamを閉じる
'''''''' [[[[ END ]]]] Make Table List. -----------------------------
'''' Make DataBase Properties List. ---------------------------

    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
    On Error Resume Next
    For Each p In cDB.Properties
            sr.WriteText """" & cDB.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, adWriteChar   '0:adWriteChar
            If Err.Number <> 0 Then Err.Clear
    Next
    sr.SaveToFile outFolder.Path & "\" & "DataBaseProperties_" & "Utf8.csv", 2   '2:adSaveCreateOverWrite
    sr.Close 'Streamを閉じる
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
    For Each v In accessObj.CurrentProject.Allfoms
    sr.WriteText v.Name, 0
    Next
    For Each v In accessObj.CurrentProject.Reports
    sr.WriteText v.Name, 0
    Next
    sr.SaveToFile outFolder.Path & "\" & "ReportAndFormList_" & "Utf8.csv", 2 '2:adSaveCreateOverWrite
    sr.Close 'Streamを閉じる
    On Error GoTo 0
'''''''' [[[[ END ]]]] Make DataBase Properties List. ----------
'''' All Object Name and ConnectionString List. -------------
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
    For Each v In cDB.TableDefs
    sr.WriteText "Table : " & v.Name & vbCrLf, 0
    If LCase(Left(v.Name, 4)) <> "msys" Then accessObj.ExportXML acExportTable, v.Name, , outFolder.Path & "\" & "TbX_" & v.Name & "utf8.xsd"
    Next
    On Error Resume Next
    For Each v In cDB.QueryDefs
    sr.WriteText "Query : " & v.Name & vbCrLf, 0
    'accessObj.ExportXml acExportQuery, v.Name , outFolder.Path & "\" & "Qry_" & v.name & "utf8.xml"　'選択クエリ、ユニオンクエリ、クロス集計クエリの一部のクエリのみしか出力できないため通常は使用しない
    Next
    If Err.Number <> 0 Then Err.Clear
    On Error GoTo 0
    For Each v In accessObj.Application.CurrentProject.AllForms 'フォームの出力 スキーマに限る
    sr.WriteText "Form : " & v.Name & vbCrLf, 0
    'If blTableBackUpMode Then accessObj.ExportXml acExportReport, v.Name ,outFolder.Path & "\" & "Frm_" & v.name & "utf8.xml"
    accessObj.ExportXML acExportForm, v.Name, , outFolder.Path & "\" & "Frm_" & v.Name & "utf8.xsd"
    'accessObj.ExportXml acExportForm, v.Name ,,, outFolder.Path & "\" & "Frm_" & v.name & "utf8.xsl"
    Next
    For Each v In accessObj.Application.CurrentProject.AllReports
    sr.WriteText "Reports : " & v.Name & vbCrLf, 0
     On Error GoTo 0
     If blTableBackUpMode Then accessObj.ExportXML acExportReport, v.Name, outFolder.Path & "\" & "ReX_" & v.Name & "utf8.xml"
     accessObj.ExportXML acExportReport, v.Name, , outFolder.Path & "\" & "ReX_" & v.Name & "utf8.xsd"
     accessObj.ExportXML acExportReport, v.Name, , , outFolder.Path & "\" & "ReX_" & v.Name & "utf8.xsl"
     'accessObj.ExportXML acExportReport, v.Name, , , outFolder.Path & "\" & "RepXOp_" & v.Name & "utf8.xsl", , acUTF8, acPersistReportML
     Next
    For Each v In Application.CurrentProject.AllMacros
    sr.WriteText "Macro : " & v.Name & vbCrLf, 0
    Next
    For Each v In Application.CurrentProject.AllModules
    sr.WriteText "Module : " & v.Name & vbCrLf, 0
    Next
    sr.WriteText "AccessConnection " & Application.CurrentProject.AccessConnection & vbCrLf
    sr.WriteText "BaseConnectionString " & Application.CurrentProject.BaseConnectionString & vbCrLf
    sr.SaveToFile outFolder.Path & "\" & "AllObjName_CNStrList_" & "Utf8.txt", 2 '2:adSaveCreateOverWrite
    sr.Close 'Streamを閉じる
 
    '''' Make Each Table Properties List. ---------------------------
    Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & "LLinkTable_IdxInfo.txt") 
    For Each tdf In cDB.TableDefs
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
    On Error Resume Next
'''' Export Xml. ---[VBA]--------- Const blTableBackUpMode = True is All Table ExportXml
    If blTableBackUpMode = False Then
        If LCase(Left(tdf.Name, 4)) = "msys" Then accessObj.ExportXML acExportTable, tdf.Name, outFolder.Path & "\TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xml"
    Else
        accessObj.ExportXML acExportTable, tdf.Name, outFolder.Path & "\TbX_" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xml"
        'accessObj.ExportXML acExportTable, tdf.Name, outFolder.Path & "\TbXN" & Replace(Replace(tdf.Name, ".", "_", 1, -1), "/", "_", 1, -1) & ".xml",,,,0,32
    End If
    '''''''' [[End]] Export Xml. -------------------------------------------
    '''''''' Make LinkTableInfo. -------------------------------------------
    If tdf.Attributes And accessObj.dbAttachedODBC Then
    If tdf.indexes.Count > 0 Then
    For each idx In tdf.Indexes
    oSQL.Write """" & tdf.name & """" & "," & tdf.Indexes.Count & "," & idx.name & "," & idx.Primary & "," & idx.Unique
    Next
    Else
    oSQL.Write """" & tdf.name & """" & "," & """" & "No Index" & """" & vbCrLf
    End If
    End If
    '''''''' [[End]] Make LinkTableInfo. -------------------------------------------
    On Error Resume Next
    For Each p In tdf.Properties
      sr.WriteText tdf.Name & "," & p.Name & "," & p.Value & "," & p.Type & "," & p.Inherited & ", " & vbCrLf, 0
      If Err.Number <> 0 Then Err.Clear
    Next
    Set flds = tdf.Fields

   For Each fld In Tdf.Fields

      For Each p In fld.Properties
         sr.WriteText tdf.Name & "," & fld.Name & "," & fld.Type & "," & " Fields.prop" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
         If Err.Number <> 0 Then Err.Clear
      Next
   Next
   sr.SaveToFile outFolder.Path & "\" & tdf.Name & "Utf8.csv", 2 '2:adSaveCreateOverWrite
   sr.Close
Next
oSQL.Close:Set oSQL = Nothing

'''''''' OutPut Query StateMent. ------------------------------------------------------------------

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    For Each Q In cDB.QueryDefs
  ' SQL Statement Output to text file
    Set oSQL = fs.CreateTextFile(outFolder.Path & "\" & Replace(Replace(Q.Name, "~", "_", 1, -1), "/", "_", 1, -1) & "_SQL.txt")
    sSQL = Q.SQL
    oSQL.Write sSQL
    oSQL.Close

  
    sr.Mode = 3 '読み取り/書き込みモード
    sr.Type = 2 'テキストデータ
    sr.Charset = "UTF-8" '文字コードを指定
    sr.Open 'Streamオブジェクトを開く
       For Each p In Q.Properties
         On Error Resume Next
         sr.WriteText """" & Q.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
         If Err.Number <> 0 Then Err.Clear
         'Debug.Print """" & Q.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """"
       Next
   For Each p In Q.Properties
       sr.WriteText """" & Q.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
       If Err.Number <> 0 Then Err.Clear
   'Debug.Print """" & Q.Name & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """"
   Next
   Set flds = Q.Fields
   For Each fld In Q.Fields

      For Each p In fld.Properties
         sr.WriteText """" & Q.Name & """" & "," & """" & fld.Name & """" & "," & """" & fld.Type & """" & "," & """" & " Fields.prop" & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """" & vbCrLf, 0
       'Debug.Print """" & Q.Name & """" & "," & """" & fld.Name & """" & "," & """" & fld.Type & """" & "," & """" & " Fields.prop" & """" & "," & """" & p.Name & """" & "," & """" & p.Value & """" & "," & """" & p.Type & """" & "," & """" & p.Inherited & """"
       If Err.Number <> 0 Then Err.Clear
      Next

   Next
   sr.SaveToFile outFolder.Path & "\" & Q.Name & "Utf8.csv", 2 '2:adSaveCreateOverWrite
   sr.Close 'Streamを閉じる
   Next
   Set objColl = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Ext = "": Ext = ".qry"
    Set objColl = accessObj.CurrentData.AllQueries
    For Each obj In objColl
        FilePath = outFolder.Path & "\" & obj.Name & Ext
        accessObj.SaveAsText acQuery, obj.Name, FilePath
    Next
    Set objColl = Nothing
    Set objColl = accessObj.CurrentProject.AllReports
    Ext = "": Ext = ".rpt"
    For Each obj In objColl
        FilePath = outFolder.Path & "\" & obj.Name & Ext
        accessObj.SaveAsText acReport, obj.Name, FilePath
    Next
    Set objColl = Nothing
    Set objColl = accessObj.CurrentProject.AllMacros
    Ext = "": Ext = ".mcr"
    For Each obj In objColl
        FilePath = outFolder.Path & "\" & obj.Name & Ext
        accessObj.SaveAsText acMacro, obj.Name, FilePath
    Next
    Set objColl = Nothing
    Set objColl = accessObj.CurrentProject.AllForms
    Ext = "": Ext = ".frm"
    For Each obj In objColl
        FilePath = outFolder.Path & "\" & obj.Name & Ext
        accessObj.SaveAsText acForm, obj.Name, FilePath
    Next
    Set objColl = Nothing

''''' accdb/mdbを閉じる. -[VBA]-----------------------------------------------------------------
    accessObj.Quit 'VBA accessObj.Quit
    Set accessObj = Nothing
    On Error GoTo 0
'''' Export System Information. ---------------------------------------------------------
    With CreateObject("WScript.shell")
    If fs.FileExists(outFolder.Path & "\" & "SystemInfo.Csv") Then fs.DeleteFile outFolder.Path & "\" & "SystemInfo.Csv"
    If fs.FileExists(outFolder.Path & "\" & "EnvironmentVariable.txt") Then fs.DeleteFile outFolder.Path & "\" & "EnvironmentVariable.txt"
    cmdStr = "Cmd.Exe /c " & """" & "SystemInfo /FO CSV>"
    cmdStr = cmdStr & outFolder.Path & "\" & "SystemInfo.Csv" & """"
    .Run cmdStr, 0
    cmdStr = ""
    cmdStr = "Cmd.Exe /c " & """" & "Set >"
    cmdStr = cmdStr & outFolder.Path & "\" & "EnvironmentVariable.txt" & """"
    .Run cmdStr, 0
    End With
' Make File List. -[VBA]-------------------------------------------------------------

    Set oSQL = fs.CreateTextFile(outFolder.Path & "\FSOAccessObjectExPortFileList.txt", True, True)
    For Each oFile In outFolder.Files
      oSQL.WriteLine """" & oFile.Name & """" & "," & fs.GetExtensionName(oFile.Path)
    Next
    oSQL.Close
    Set oSQL = Nothing
    Set fs = Nothing
    Set sr = Nothing
End Sub

#XMLの見方
IE11でxmlとxslが文字でネットワーク越しで見れた

手っ取り早いのは、ファイルサーバやNASなどに保存して、それを見る方法。それがダメなら、自分のパソコン内に共有フォルダを作成、アクセス権に自分だけを設定して、そこにファイルを保存。
んで、ファイルを見たい時には、「¥¥端末名（又はIPアドレス）¥共有名」でアクセスして、そこからxmlファイルをダブルクリックすれば良いわけです。

※IE11を起動しアドレス欄に\...htmまで打ち込む
完全な出力をしている場合はhtmで開ける
#戻す方法
[Access]MS Accessのmodulesをソース管理する方法１]
#参考リンク
AccessのVBAソースを一括エクスポートする
VBAで参照設定を設定・解除する（ACCESS）
マクロで参照設定を操作する - Office Tanaka
ACCESSのVBAのモジュール、クエリを一括でエクスポートしたい

SaveAsText、LoadFromTextという隠しコマンドがあります。
Query,Form,Report,Moduleのエクスポート/インポートに使えます。
引数は ObjectType,ObjectName,FileName です。エディタで使うとすぐにわかると思います。
このコマンドではテーブルはデータの保存なので、ExportXML、ImportXMLでテーブル定義のインポート/エクスポートをすればローカルテーブルもバックアップできます。
あとは、次の内容を出力しておけば、ほぼプロジェクトのバックアップにもなります。
（ごめんなさい、100%かどうかの保証はありません。ご了承ください）
・データベースプロパティ
・リンクテーブルと疑似インデックス
・リレーション
・インポート/エクスポート定義

インポート/エクスポート定義以外は、DAOで書き出せます。
インポート/エクスポート定義は、内部テーブルに持っていますので、そのテーブルをエクスポートしておけばOKです。
（MSysIMEXで始まる2つのテーブル）

Office Space: Microsoft Access で XML データをインポートおよびエクスポートする
[MS Access] システムテーブル(MSys*) を区別する方法
Application.ExportXML メソッド (Access)

式.ExportXML(ObjectType, DataSource, DataTarget, SchemaTarget, PresentationTarget, ImageTarget, Encoding, OtherFlags, WhereCondition, AdditionalData)

AcExportXMLEncoding 列挙 (Access)
acUTF8 0 (既定値) UTF8 エンコード。ほかは acUTF32
AcExportXMLOtherFlags 列挙 (Access)
※ただし実際は出力データの容量に変化はなく使用していない。

名前 値 説明
acEmbedSchema 1 引数 DataTarget で指定したドキュメントにスキーマ情報を書き込みます。この引数の値は引数 SchemaTarget よりも優先されます。
acExcludePrimaryKeyAndIndexes 2 主キーおよびインデックスのスキーマ プロパティはエクスポートしません。
acExportAllTableAndFieldProperties 32 エクスポートされたスキーマに、テーブルとそのフィールドのプロパティが含まれます。
acLiveReportSource 8 リモートの Microsoft SQL Server 2000 データベースへのライブ リンクを作成します。Microsoft SQL Server 2000 データベースに連結されたレポートをエクスポートするときだけ有効です。
acPersistReportML 16 エクスポートされたオブジェクトの ReportML 情報を維持します。
acRunFromServer 4 ASP wrapper を作成します。既定値は HTML wrapper です。レポートをエクスポートするときのみ適用されます。

CurrentDataプロパティを用いて全クエリ名を取得する方法 ： VBAのTips解説
フォーム参照のパラメータクエリをVBAで扱う方法
テーブルやクエリ名をプログラムから一括変更する方法
クエリーを使ってオブジェクト一覧を取り出す方法
Access データベースのテーブルのリストを作成する

27
45
8

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
27
45

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?