'--------------------------------------------------
' Author : ghudson. Sub copied from: topic 99179 on access-programmers.co.uk (full link removed due to my low post count :o)
' Thread name: Export All Database Objects Into Text Files
'Modified : papyturbo. Added CleanFileNames() control + export in a subdir, inside the current project's.
'--------------------------------------------------
Public Sub ExportDatabaseObjects(Optional ExportTables As Boolean = False)
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
'Dim db As DAO.Database
Dim td As TableDef
Dim d As Document
Dim C As Container
Dim i As Integer
Dim sExportLocation As String
Set db = CurrentDb()
sExportLocation = CurrentProject.Path & "\++ ExportText\" 'Do not forget the closing back slash! ie: C:\Temp\
If ExportTables Then
Debug.Print "Exporting Tables..."
For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" Then
'will not work on french Windows/Office.
'Error 3441 Le séparateur du champ de spécification du fichier texte est identique au séparateur décimal ou au délimiteur de texte.
' /*error 3441 message is bull....., in this case
DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True
End If
Next td
End If
Debug.Print "Exporting Forms..."
Set C = db.Containers("Forms")
For Each d In C.Documents
Application.SaveAsText acForm, d.Name, sExportLocation & "Form_" & CleanFileNames(d.Name) & ".txt"
Next d
Debug.Print "Exporting Reports..."
Set C = db.Containers("Reports")
For Each d In C.Documents
Application.SaveAsText acReport, d.Name, sExportLocation & "Report_" & CleanFileNames(d.Name) & ".txt"
Next d
Debug.Print "Exporting Macros..."
Set C = db.Containers("Scripts")
For Each d In C.Documents
Application.SaveAsText acMacro, d.Name, sExportLocation & "Macro_" & CleanFileNames(d.Name) & ".txt"
Next d
Debug.Print "Exporting Modules..."
Set C = db.Containers("Modules")
For Each d In C.Documents
Application.SaveAsText acModule, d.Name, sExportLocation & "Module_" & CleanFileNames(d.Name) & ".txt"
Next d
Debug.Print "Exporting Queries..."
For i = 0 To db.QueryDefs.Count - 1
Application.SaveAsText acQuery, db.QueryDefs(i).Name, sExportLocation & "Query_" & CleanFileNames(db.QueryDefs(i).Name) & ".txt"
Next i
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Finally:
On Error Resume Next
Set db = Nothing
Set C = Nothing
Exit Sub '======================================
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
'added by papyturbo:
Debug.Print Err, Err.Description
Stop
Resume
Resume Finally
End Sub
'--------------------------------------------------
' 2011/02/15
' Author : papyturbo. Provides proper names for Windows files.
' You may change the replacement character as wanted, provided it is a legal character...
'--------------------------------------------------
Private Function CleanFileNames(ObjectName As String) As String
Const REPLACEMENT$ = "_"
CleanFileNames = Replace(ObjectName, "/", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, "\", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, ":", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, "*", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, "?", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, """", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, "<", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, ">", REPLACEMENT)
CleanFileNames = Replace(CleanFileNames, "|", REPLACEMENT)
End Function