Auto Backup of Split Database. (1 Viewer)

Private Sub Form_Unload(Cancel As Integer)
    If Environ("username") = "phartman" Or Environ("username") = "Pat" Then
        If MsgBox("Save as text?", vbYesNo) = vbYes Then
            Call ExportOnClose
        End If
    End If
    
End Sub

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

Public Sub ImportForm()
    Application.Application.LoadFromText acForm, "sfrmReconcilePayments", "C:\Pat\RAS\TextFiles120926A\Form_sfrmReconcilePayments.txt"
End Sub
Public Sub ExportForm()
    Application.SaveAsText acForm, "frmReconcilePayments", "C:\Pat\RAS\TextFiles120927A\Form_frmReconcilePaymentsOLD.txt"
End Sub