Option Compare Database
Option Explicit
Public iCountForms As Integer
Public iCountReports As Integer
Public iCountQueries As Integer
Public iCountModules As Integer
Public iCountScripts As Integer 'macros
Public Sub ExportOnClose()
'''REQUIRES reference to Office xx Object Library
Dim strPath As String
Dim objFSO As Object
Dim strMsg As String
On Error GoTo ErrProc
'create new folder
strPath = "C:\Pat\RAS\TextFiles" & Format(Date, "yymmdd")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(strPath) Then
objFSO.CreateFolder (strPath)
Else
strPath = strPath & "A"
If Not objFSO.FolderExists(strPath) Then
objFSO.CreateFolder (strPath)
Else
strPath = InputBox("enter path please")
objFSO.CreateFolder (strPath)
End If
End If
'export all objects
MsgBox "This may take a few minutes. Please wait for the count message.", vbOKOnly
Call ExportDatabaseObjects("forms", strPath)
Call ExportDatabaseObjects("reports", strPath)
Call ExportDatabaseObjects("modules", strPath)
Call ExportDatabaseObjects("QueryDefs", strPath)
Call ExportDatabaseObjects("scripts", strPath)
strMsg = "Exported Forms = " & iCountForms & vbCrLf
strMsg = strMsg & " Reports = " & iCountReports & vbCrLf
strMsg = strMsg & " Modules = " & iCountModules & vbCrLf
strMsg = strMsg & " Queries = " & iCountQueries & vbCrLf
strMsg = strMsg & " Macros = " & iCountScripts & vbCrLf
Debug.Print strMsg
MsgBox strMsg, vbOKOnly
ExitProc:
Exit Sub
ErrProc:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
End Select
End Sub
Public Sub ExportDatabaseObjects(ExportType As String, Optional ExpLoc As Variant)
On Error GoTo Err_ExportDatabaseObjects
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"
If ExpLoc & "" = "" Then
sExportLocation = "C:\Pat\RAS\TextFiles\" 'Do not forget the closing back slash! ie: C:\Temp\
Else
sExportLocation = ExpLoc
End If
If Right(sExportLocation, 1) = "\" Then
Else
sExportLocation = sExportLocation & "\"
End If
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")
iCountForms = 0
For Each D In C.Documents
Application.SaveAsText acForm, D.Name, sExportLocation & "Form_" & D.Name & ".txt"
iCountForms = iCountForms + 1
Next D
Case "Reports"
Set C = db.Containers("Reports")
iCountReports = 0
For Each D In C.Documents
Application.SaveAsText acReport, D.Name, sExportLocation & "Report_" & D.Name & ".txt"
iCountReports = iCountReports + 1
Next D
Case "Scripts"
Set C = db.Containers("Scripts")
iCountScripts = 0
For Each D In C.Documents
Application.SaveAsText acMacro, D.Name, sExportLocation & "Macro_" & D.Name & ".txt"
iCountScripts = iCountScripts + 1
Next D
Case "Modules"
Set C = db.Containers("Modules")
iCountModules = 0
For Each D In C.Documents
Application.SaveAsText acModule, D.Name, sExportLocation & "Module_" & D.Name & ".txt"
iCountModules = iCountModules + 1
Next D
Case "QueryDefs"
iCountQueries = 0
For i = 0 To db.QueryDefs.Count - 1
Application.SaveAsText acQuery, db.QueryDefs(i).Name, sExportLocation & "Query_" & db.QueryDefs(i).Name & ".txt"
iCountQueries = iCountQueries + 1
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