転ばぬ先の杖程度。
'----------------------------------------------------------------------
' Sub : gsub_SaveAsText
' 全てのオブジェクトをテキストとして保存する
' 復旧にはLoadFromTextを用いる
' 例) LoadFromText acDataAccessPage, "", "ファイルパス"
'----------------------------------------------------------------------
Public Sub gsub_SaveAsText()
Dim obj As Object
Dim i As Long
Dim strDir As String
Dim strName As String
Dim tdf As TableDef
Dim qdf As QueryDef
On Error Resume Next
strDir = CurrentProject.Path & "\SaveAsText\"
If (PathIsDirectory(strDir) = False) Then
MkDir strDir
End If
'---< TABLE >
SaveAsText acDataAccessPage, "", strDir & "Tables" & gcntExtensionTxt
'---< QUERY >
For Each qdf In CurrentDb.QueryDefs
strName = qdf.Name
If Not (Left(strName, 1) = "~") Then
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acQuery, strName, strDir & strName & gcntExtensionTxt
End If
Next qdf
'---< FORM >
For i = 0 To CurrentProject.AllForms.Count - 1
strName = CurrentProject.AllForms(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acForm, strName, strDir & strName & gcntExtensionTxt
Next i
'---< REPORT >
For i = 0 To CurrentProject.AllReports.Count - 1
strName = CurrentProject.AllReports(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acReport, strName, strDir & strName & gcntExtensionTxt
Next i
'---< MACRO >
For i = 0 To CurrentProject.AllMacros.Count - 1
strName = CurrentProject.AllMacros(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acMacro, strName, strDir & strName & gcntExtensionTxt
Next i
'---< MODULE >
For i = 0 To CurrentProject.AllModules.Count - 1
strName = CurrentProject.AllModules(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acModule, strName, strDir & strName & gcntExtensionTxt
Next i
'---< END >
MsgBox "Done.", vbInformation
End Sub
