© DOWNLOAD

Option Base 0
Option Explicit

Dim path$
Dim DateTimeString$
Dim app As Access.Application

Private Sub SaveMDBObjectsAsText()
    Dim r As Reference
    DateTimeString = Format(Now(), "yyyymmddhhnn")
    path = CurrentProject.path & "\AS_TEXT_" & DateTimeString & "\"
    MkDir path
    Set app = New Access.Application
    SaveDataAccessPagesAsText
    SaveFormsAsText
    SaveReportsAsText
    SaveModulesAsText
    SaveQueriesAsText
    SaveMDBBase
    LoadDataAccessPagesFromText
    LoadFormsFromText
    LoadReportsFromText
    LoadModulesFromText
    LoadQueriesFromText
    On Error Resume Next
    With app
        With .CurrentProject
            path = .FullName
        End With
        
        For Each r In .References
            With r
                If Not .BuiltIn Then
                    app.References.Remove r
                End If
            End With
        Next r
        
        For Each r In References
            With r
                If Not .BuiltIn Then
                    app.References.AddFromGuid r.Guid, r.Major, r.Minor
                End If
            End With
        Next r
        
        .RunCommand acCmdCompileAndSaveAllModules
        .CloseCurrentDatabase
        .SysCmd 603, path, Replace(path, ".mdb", ".mde")
        .Quit
    End With
    Set app = Nothing
    MsgBox "All Done with Text Backup"
End Sub

Private Sub SaveDataAccessPagesAsText()
    Dim FileName$
    Dim Name$
    Dim DataAccessPage As AccessObject
    For Each DataAccessPage In CurrentProject.AllDataAccessPages
        Name = DataAccessPage.Name
        FileName = path & Name & ".txt"
        SaveAsText acDataAccessPage, Name, FileName
    Next DataAccessPage
End Sub

Private Sub SaveFormsAsText()
    Dim FileName$
    Dim Name$
    Dim Form As AccessObject
    For Each Form In CurrentProject.AllForms
        Name = Form.Name
        FileName = path & Name & ".txt"
        SaveAsText acForm, Name, FileName
    Next Form
End Sub

Private Sub SaveReportsAsText()
    Dim FileName$
    Dim Name$
    Dim Report As AccessObject
    For Each Report In CurrentProject.AllReports
        Name = Report.Name
        FileName = path & Name & ".txt"
        SaveAsText acReport, Name, FileName
    Next Report
End Sub

Private Sub SaveMacrosAsText()
    Dim FileName$
    Dim Name$
    Dim Macro As AccessObject
    For Each Macro In CurrentProject.AllMacros
        Name = Macro.Name
        FileName = path & Name & ".txt"
        SaveAsText acMacro, Name, FileName
    Next Macro
End Sub

Private Sub SaveModulesAsText()
    Dim FileName$
    Dim Name$
    Dim Module As AccessObject
    For Each Module In CurrentProject.AllModules
        Name = Module.Name
        FileName = path & Name & ".txt"
        SaveAsText acModule, Name, FileName
    Next Module
End Sub

Private Sub SaveQueriesAsText()
    Dim FileName$
    Dim Name$
    Dim GetQueryNames As ADODB.recordset
    Set GetQueryNames = CurrentProject.Connection.OpenSchema(adSchemaViews)
    With GetQueryNames
        Do While Not .EOF
            Name = .Fields("TABLE_NAME")
            FileName = path & Name & ".txt"
            SaveAsText acQuery, Name, FileName
            .MoveNext
        Loop
    End With
End Sub

Private Sub SaveMDBBase()
    Dim FileName$
    Dim Name$
    Name = Replace(CurrentProject.Name, CurrentProject.path, "")
    FileName = path & Name
    SaveAsText 6, "", FileName
    app.OpenCurrentDatabase FileName
End Sub

Private Sub LoadDataAccessPagesFromText()
    Dim FileName$
    Dim Name$
    Dim DataAccessPage As AccessObject
    For Each DataAccessPage In CurrentProject.AllDataAccessPages
        Name = DataAccessPage.Name
        FileName = path & Name & ".txt"
        app.LoadFromText acDataAccessPage, Name, FileName
    Next DataAccessPage
End Sub

Private Sub LoadFormsFromText()
    Dim FileName$
    Dim Name$
    Dim Form As AccessObject
    For Each Form In CurrentProject.AllForms
        Name = Form.Name
        FileName = path & Name & ".txt"
        app.LoadFromText acForm, Name, FileName
    Next Form
End Sub

Private Sub LoadReportsFromText()
    Dim FileName$
    Dim Name$
    Dim Report As AccessObject
    For Each Report In CurrentProject.AllReports
        Name = Report.Name
        FileName = path & Name & ".txt"
        app.LoadFromText acReport, Name, FileName
    Next Report
End Sub

Private Sub LoadModulesFromText()
    Dim FileName$
    Dim Name$
    Dim Module As AccessObject
    For Each Module In CurrentProject.AllModules
        Name = Module.Name
        FileName = path & Name & ".txt"
        app.LoadFromText acModule, Name, FileName
    Next Module
End Sub

Private Sub LoadMacrosFromText()
    Dim FileName$
    Dim Name$
    Dim Macro As AccessObject
    For Each Macro In CurrentProject.AllMacros
        Name = Macro.Name
        FileName = path & Name & ".txt"
        app.LoadFromText acMacro, Name, FileName
    Next Macro
End Sub

Private Sub LoadQueriesFromText()
    Dim FileName$
    Dim Name$
    Dim GetQueryNames As ADODB.recordset
    Set GetQueryNames = CurrentProject.Connection.OpenSchema(adSchemaViews)
    With GetQueryNames
        Do While Not .EOF
            Name = .Fields("TABLE_NAME")
            FileName = path & Name & ".txt"
            app.LoadFromText acQuery, Name, FileName
            .MoveNext
        Loop
    End With
End Sub

Back