Public Sub RunCode()
Call ExportDatabaseObjects("Modules")
Call ExportDatabaseObjects("Forms")
Call ExportDatabaseObjects("Reports")
Call ExportDatabaseObjects("Querydefs")
Call ExportDatabaseObjects("Scripts")
End Sub
Public Sub ExportDatabaseObjects(ExportType As String)
On Error GoTo Err_ExportDatabaseObjects
'Dim db As Database
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim D As Document
Dim C As Container
Dim i As Integer
Dim sExportLocation As String
Set db = CurrentDb()
''import from text =
''application.Application.LoadFromText acForm, "frmRisks","C:\Temp\TextRiskReview070615\Form_frmRisks.txt"
sExportLocation = "F:\Data\___db backups - please do not remove\TextObjects\" 'Do not forget the closing back slash! ie: C:\Temp\
Select Case ExportType
Case "TableDefs"
For Each td In db.TableDefs 'Tables
If Left(td.Name, 4) <> "MSys" Then
DoCmd.TransferText acExportDelim, , td.Name, sExportLocation & "Table_" & td.Name & ".txt", True
End If
Next td
Case "Forms"
Set C = db.Containers("Forms")
For Each D In C.Documents
Application.SaveAsText acForm, D.Name, sExportLocation & "Form_" & D.Name & ".txt"
Next D
Case "Reports"
Set C = db.Containers("Reports")
For Each D In C.Documents
Application.SaveAsText acReport, D.Name, sExportLocation & "Report_" & D.Name & ".txt"
Next D
Case "Scripts"
Set C = db.Containers("Scripts")
For Each D In C.Documents
Application.SaveAsText acMacro, D.Name, sExportLocation & "Macro_" & D.Name & ".txt"
Next D
Case "Modules"
Set C = db.Containers("Modules")
For Each D In C.Documents
Application.SaveAsText acModule, D.Name, sExportLocation & "Module_" & D.Name & ".txt"
Next D
Case "QueryDefs"
For i = 0 To db.QueryDefs.Count - 1
Application.SaveAsText acQuery, db.QueryDefs(i).Name, sExportLocation & "Query_" & db.QueryDefs(i).Name & ".txt"
Next i
Case Else
End Select
Set db = Nothing
Set C = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
