将 MS Access 表单和类/模块递归导出到文本文件？

Question

I found some code on an ancient message board that nicely exports all of the VBA code from classes, modules and forms (see below):

Option Explicit
Option Compare Database
Function SaveToFile()                  'Save the code for all modules to files in currentDatabaseDir\Code

Dim Name As String
Dim WasOpen As Boolean
Dim Last As Integer
Dim I As Integer
Dim TopDir As String, Path As String, FileName As String
Dim F As Long                          'File for saving code
Dim LineCount As Long                  'Line count of current module

I = InStrRev(CurrentDb.Name, "\")
TopDir = VBA.Left(CurrentDb.Name, I - 1)
Path = TopDir & "\" & "Code"           'Path where the files will be written

If (Dir(Path, vbDirectory) = "") Then
  MkDir Path                           'Ensure this exists
End If

'--- SAVE THE STANDARD MODULES CODE ---

Last = Application.CurrentProject.AllModules.Count - 1

For I = 0 To Last
  Name = CurrentProject.AllModules(I).Name
  WasOpen = True                       'Assume already open

  If Not CurrentProject.AllModules(I).IsLoaded Then
    WasOpen = False                    'Not currently open
    DoCmd.OpenModule Name              'So open it
  End If

  LineCount = Access.Modules(Name).CountOfLines
  FileName = Path & "\" & Name & ".vba"

  If (Dir(FileName) <> "") Then
    Kill FileName                      'Delete previous version
  End If

  'Save current version
  F = FreeFile
  Open FileName For Output Access Write As #F
  Print #F, Access.Modules(Name).Lines(1, LineCount)
  Close #F

  If Not WasOpen Then
    DoCmd.Close acModule, Name         'It wasn't open, so close it again
  End If
Next

'--- SAVE FORMS MODULES CODE ---

Last = Application.CurrentProject.AllForms.Count - 1

For I = 0 To Last
  Name = CurrentProject.AllForms(I).Name
  WasOpen = True

  If Not CurrentProject.AllForms(I).IsLoaded Then
    WasOpen = False
    DoCmd.OpenForm Name, acDesign
  End If

  LineCount = Access.Forms(Name).Module.CountOfLines
  FileName = Path & "\" & Name & ".vba"

  If (Dir(FileName) <> "") Then
    Kill FileName
  End If

  F = FreeFile
  Open FileName For Output Access Write As #F
  Print #F, Access.Forms(Name).Module.Lines(1, LineCount)
  Close #F

  If Not WasOpen Then
    DoCmd.Close acForm, Name
  End If
Next
MsgBox "Created source files in " & Path
End Function

However, this code does not solve my problem since I have 110 ms-access *.mdb 's that I need to export the vba from into text files suitable for grepping.

The paths to the 110 files I'm interested in are already stored in a table, and my code already gained this information recursively (along with some other filtering)...so the recursive part is done.

Most of these files are opened by a single access user security file, an .mdw and I have tried several methods of opening them. ADO and ADOX worked great when I was searching for linked tables in these directories...but the code above involves being inside the database you are exporting the data from , and I want to be able to do this from a separate database that opens all of the mdb s and performs the export on each of them.

One of my attempts at this involved using the PrivDBEngine class to connect to the databases externally, but it doesn't allow me to access the Application object which is what the export code above requires.

Private Sub exportToFile(db_path As String, db_id As String, loginInfo As AuthInfoz, errFile As Variant)

    Dim pdbeNew As PrivDBEngine
    Dim db As DAO.Database
    Dim ws As DAO.Workspace
    Dim rst As DAO.Recordset

    Dim cn As ADODB.Connection ' ADODB.Connection
    Dim rs As ADODB.Recordset ' ADODB.Recordset
    Dim strConnect As String
    Dim blnReturn As Boolean

    Dim Doc              As Document
    Dim mdl              As Module
    Dim lngCount         As Long
    Dim strForm          As String
    Dim strOneLine       As String
    Dim sPtr             As Integer

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set exportFile = fso.CreateTextFile("E:\Tickets\CSN1006218\vbacode\" & db_id & ".txt", ForAppending)

    ' Export stuff...

    On Error GoTo errorOut

    Set pdbeNew = New PrivDBEngine
    With pdbeNew
        .SystemDB = loginInfo.workgroup
        .DefaultUser = loginInfo.username
        .DefaultPassword = loginInfo.password
    End With


    Set ws = pdbeNew.Workspaces(0)


    Set db = ws.OpenDatabase(db_path)

    For Each Doc In db.Containers("Modules").Documents
        DoCmd.OpenModule Doc.Name
        Set mdl = Modules(Doc.Name)

        exportFile.WriteLine ("---------------------")
        exportFile.WriteLine ("Module Name: " & Doc.Name)
        exportFile.WriteLine ("Module Type: " & mdl.Type)
        exportFile.WriteLine ("---------------------")

        lngCount = lngCount + mdl.CountOfLines

        'For i = 1 To lngCount
        '    strOneLine = mdl.Lines(i, 1)
        '    exportFile.WriteLine (strOneLine)
        'Next i

        Set mdl = Nothing
        DoCmd.Close acModule, Doc.Name
    Next Doc

Close_n_exit:

    If Not (db Is Nothing) Then
        Call wk.Close
        Set wk = Nothing
        Call db.Close
    End If



    Call exportFile.Close
    Set exportFile = Nothing
    Set fso = Nothing

    Exit Sub

errorOut:
    Debug.Print "----------------"
    Debug.Print "BEGIN: Err"
    If err.Number <> 0 Then
        Msg = "Error # " & Str(err.Number) & " was generated by " _
         & err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & err.Description
        'MsgBox Msg, , "Error", err.HelpFile, err.HelpContext
        Debug.Print Msg
    End If
    Resume Close_n_exit

End Sub

Is there anyway to access the application object from a PrivDBEngine ? I have alot of modules that need grepping.

Answer 1

You can also try this code. It will preserve the items' filetypes (.bas, .cls, .frm) Remember to refer to / Check the Microsoft Visual Basic For Applications Extensibility Library in VBE > Tools > References

Public Sub ExportAllCode()

    Dim c As VBComponent
    Dim Sfx As String

    For Each c In Application.VBE.VBProjects(1).VBComponents
        Select Case c.Type
            Case vbext_ct_ClassModule, vbext_ct_Document
                Sfx = ".cls"
            Case vbext_ct_MSForm
                Sfx = ".frm"
            Case vbext_ct_StdModule
                Sfx = ".bas"
            Case Else
                Sfx = ""
        End Select

        If Sfx <> "" Then
            c.Export _
                Filename:=CurrentProject.Path & "\" & _
                c.Name & Sfx
        End If
    Next c

End Sub

Answer 2

You can use the Access.Application object.

Also, in order to avoid multiple confirmation dialogs when opening the databases, just change the security level in Tools / Macros / Security.

And to open multiple databases with user/password you can join the workgroup (Tools / Security / Workgroup administrator) and log in with the desired user/password (from the database with the SaveToFile function), then run the code. Remember, later on, to join the default workgroup (you can try to join an inexistent workgroup and access will revert to the default).

Option Explicit
Option Compare Database


'Save the code for all modules to files in currentDatabaseDir\Code
Public Function SaveToFile()

   On Error GoTo SaveToFile_Err
    
   Dim Name As String
   Dim WasOpen As Boolean
   Dim Last As Integer
   Dim i As Integer
   Dim TopDir As String, Path As String, FileName As String
   Dim F As Long                          'File for saving code
   Dim LineCount As Long                  'Line count of current module
    
   Dim oApp As New Access.Application
    
   ' Open remote database
   oApp.OpenCurrentDatabase ("D:\Access\myDatabase.mdb"), False

    
   i = InStrRev(oApp.CurrentDb.Name, "\")
   TopDir = VBA.Left(oApp.CurrentDb.Name, i - 1)
   Path = TopDir & "\" & "Code"           'Path where the files will be written
    
   If (Dir(Path, vbDirectory) = "") Then
      MkDir Path                           'Ensure this exists
   End If
    
   '--- SAVE THE STANDARD MODULES CODE ---
    
   Last = oApp.CurrentProject.AllModules.Count - 1
    
   For i = 0 To Last
      Name = oApp.CurrentProject.AllModules(i).Name
      WasOpen = True                       'Assume already open
    
         If Not oApp.CurrentProject.AllModules(i).IsLoaded Then
            WasOpen = False                    'Not currently open
            oApp.DoCmd.OpenModule Name              'So open it
         End If
    
      LineCount = oApp.Modules(Name).CountOfLines
      FileName = Path & "\" & Name & ".vba"
    
      If (Dir(FileName) <> "") Then
        Kill FileName                      'Delete previous version
      End If
    
      'Save current version
      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Modules(Name).Lines(1, LineCount)
      Close #F
    
      If Not WasOpen Then
         oApp.DoCmd.Close acModule, Name         'It wasn't open, so close it again
      End If
   Next
    
   '--- SAVE FORMS MODULES CODE ---
    
   Last = oApp.CurrentProject.AllForms.Count - 1
   
   For i = 0 To Last
      Name = oApp.CurrentProject.AllForms(i).Name
      WasOpen = True
    
      If Not oApp.CurrentProject.AllForms(i).IsLoaded Then
         WasOpen = False
         oApp.DoCmd.OpenForm Name, acDesign
      End If
    
      LineCount = oApp.Forms(Name).Module.CountOfLines
      FileName = Path & "\" & Name & ".vba"
    
      If (Dir(FileName) <> "") Then
         Kill FileName
      End If
    
      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Forms(Name).Module.Lines(1, LineCount)
      Close #F
    
      If Not WasOpen Then
         oApp.DoCmd.Close acForm, Name
      End If
   Next
   
   '--- SAVE REPORTS MODULES CODE ---
    
   Last = oApp.CurrentProject.AllReports.Count - 1
   
   For i = 0 To Last
      Name = oApp.CurrentProject.AllReports(i).Name
      WasOpen = True
    
      If Not oApp.CurrentProject.AllReports(i).IsLoaded Then
         WasOpen = False
         oApp.DoCmd.OpenReport Name, acDesign
      End If
    
      LineCount = oApp.Reports(Name).Module.CountOfLines
      FileName = Path & "\" & Name & ".vba"
    
      If (Dir(FileName) <> "") Then
         Kill FileName
      End If
    
      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Reports(Name).Module.Lines(1, LineCount)
      Close #F
    
      If Not WasOpen Then
         oApp.DoCmd.Close acReport, Name
      End If
   Next
   
   MsgBox "Created source files in " & Path
    
   ' Reset the security level
   Application.AutomationSecurity = msoAutomationSecurityByUI
   
SaveToFile_Exit:
   
   If Not oApp.CurrentDb Is Nothing Then oApp.CloseCurrentDatabase
   If Not oApp Is Nothing Then Set oApp = Nothing
   Exit function

SaveToFile_Err:

   MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)
   Resume SaveToFile_Exit

End Function

I have added code for the Reports modules. When I get some time I'll try to refactor the code.

I find this a great contribution. Thanks for sharing.

Regards

================= EDIT ==================

After a while I found the way to export the whole database (tables and queries included) and have been using it for version control in Git.

Of course, if you have really big tables what you really want is a backup. This I use with the tables in its initial state, many of them empty, for development purposes only.

         Option Compare Database
         Option Explicit

  Private Const VB_MODULE               As Integer = 1
  Private Const VB_CLASS                As Integer = 2
  Private Const VB_FORM                 As Integer = 100
  Private Const EXT_TABLE               As String = ".tbl"
  Private Const EXT_QUERY               As String = ".qry"
  Private Const EXT_MODULE              As String = ".bas"
  Private Const EXT_CLASS               As String = ".cls"
  Private Const EXT_FORM                As String = ".frm"
  Private Const CODE_FLD                As String = "code"

  Private Const mblnSave                As Boolean = True               ' False: just generate the script
'
'

Public Sub saveAllAsText()

            Dim oTable                  As TableDef
            Dim oQuery                  As QueryDef
            Dim oCont                   As Container
            Dim oForm                   As Document
            Dim oModule                 As Object
            Dim FSO                     As Object
        
            Dim strPath                 As String
            Dim strName                 As String
            Dim strFileName             As String
    
'**
    On Error GoTo errHandler
    
    strPath = CurrentProject.path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    strPath = addFolder(FSO, strPath, Application.CurrentProject.name & "_" & CODE_FLD)
    strPath = addFolder(FSO, strPath, Format(Date, "yyyy.mm.dd"))

    
    For Each oTable In CurrentDb.TableDefs
        strName = oTable.name
        If left(strName, 4) <> "MSys" Then
            strFileName = strPath & "\" & strName & EXT_TABLE
            If mblnSave Then Application.ExportXML acExportTable, strName, strFileName, strFileName & ".XSD", strFileName & ".XSL", , acUTF8, acEmbedSchema + acExportAllTableAndFieldProperties
            Debug.Print "Application.ImportXML """ & strFileName & """, acStructureAndData"
        End If
    Next
    
    For Each oQuery In CurrentDb.QueryDefs
        strName = oQuery.name
        If left(strName, 1) <> "~" Then
            strFileName = strPath & "\" & strName & EXT_QUERY
            If mblnSave Then Application.SaveAsText acQuery, strName, strFileName
            Debug.Print "Application.LoadFromText acQuery, """ & strName & """, """ & strFileName & """"
        End If
    Next
    
    Set oCont = CurrentDb.Containers("Forms")
    For Each oForm In oCont.Documents
        strName = oForm.name
        strFileName = strPath & "\" & strName & EXT_FORM
        If mblnSave Then Application.SaveAsText acForm, strName, strFileName
        Debug.Print "Application.LoadFromText acForm, """ & strName & """, """ & strFileName & """"
    Next
    
    strPath = addFolder(FSO, strPath, "modules")
    For Each oModule In Application.VBE.ActiveVBProject.VBComponents
        strName = oModule.name
        strFileName = strPath & "\" & strName
        Select Case oModule.Type
            Case VB_MODULE
                If mblnSave Then oModule.Export strFileName & EXT_MODULE
                Debug.Print "Application.VBE.ActiveVBProject.VBComponents.Import """ & strFileName & EXT_MODULE; """"
            Case VB_CLASS
                If mblnSave Then oModule.Export strFileName & EXT_CLASS
                Debug.Print "Application.VBE.ActiveVBProject.VBComponents.Import """ & strFileName & EXT_CLASS; """"
            Case VB_FORM
                ' Do not export form modules (already exported the complete forms)
            Case Else
                Debug.Print "Unknown module type: " & oModule.Type, oModule.name
        End Select
    Next
    
    If mblnSave Then MsgBox "Files saved in  " & strPath, vbOKOnly, "Export Complete"

Exit Sub

errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf
    Stop: Resume

End Sub
'

'
' Create a folder when necessary. Append the folder name to the given path.
'
Private Function addFolder(ByRef FSO As Object, ByVal strPath As String, ByVal strAdd As String) As String
    addFolder = strPath & "\" & strAdd
    If Not FSO.FolderExists(addFolder) Then MkDir addFolder
End Function
'

EDIT2

---

When saving queries, they often get changed in trivial aspects which I don't want to get commited to the git repository. I changed the code so it just exports the SQL code in the query.

For Each oQuery In CurrentDb.QueryDefs
    strName = oQuery.Name
    If Left(strName, 1) <> "~" Then
        strFileName = strPath & "\" & strName & EXT_QUERY
        saveQueryAsText oQuery, strFileName
    End If
Next

'
' Save just the SQL code in the query
'
Private Sub saveQueryAsText(ByVal oQuery As QueryDef, ByVal strFileName As String)
        
   Dim intFile As Integer

   intFile = FreeFile
   Open strFileName For Output As intFile
   Print #intFile, oQuery.sql
   Close intFile

End Sub

And to import and recreate the database I use another module, mDBImport. In the repository, the modules are contained in the 'modules' subfolder:

Private Const repoPath As String = "C:\your\repository\path\here"

Public Sub loadFromText(Optional ByVal strPath As String = REPOPATH)

   dim FSO as Object

   Set oFolder = FSO.GetFolder(strPath)
   Set FSO = CreateObject("Scripting.FileSystemObject")

   For Each oFile In oFolder.files
      Select Case FSO.GetExtensionName(oFile.Path)
      Case "tbl"
         Application.ImportXML oFile.Path, acStructureAndData
      Case "qry"
         intFile = FreeFile
         Open oFile.Path For Input As #intFile
         strSQL = Input$(LOF(intFile), intFile)
         Close intFile
         CurrentDb.CreateQueryDef Replace(oFile.Name, ".qry", ""), strSQL
        
      Case "frm"
         Application.loadFromText acForm, Replace(oFile.Name, ".frm", ""), oFile.Path
      End Select
   Next oFile

   ' load modules and class modules
   strPath = FSO.BuildPath(strPath, "modules")
   If Not FSO.FolderExists(strPath) Then Err.Raise vbObjectError + 4, , "Modules folder doesn't exist!"
   Set oFolder = FSO.GetFolder(strPath)
   
   With Application.VBE.ActiveVBProject.VBComponents
      For Each oFile In oFolder.files
         Select Case FSO.GetExtensionName(oFile.Path)
         Case "cls", "bas"
            If oFile.Name <> "mDBImport.bas" Then .Import oFile.Path
         End Select
      Next oFile
   End With

   MsgBox "The database objects where correctly loaded.", vbOKOnly, "LoadFromText"

Exit Sub

errHandler:
   MsgBox Err.Description, vbCritical + vbOKOnly

End Sub

Answer 3

Like for MS Excel, you can also use a loop over the Application.VBE.VBProjects(1).VBComponents and use the Export method to export your modules/classes/forms:

Const VB_MODULE = 1
Const VB_CLASS = 2
Const VB_FORM = 100
Const EXT_MODULE = ".bas"
Const EXT_CLASS = ".cls"
Const EXT_FORM = ".frm"
Const CODE_FLD = "Code"

Sub ExportAllCode()

Dim fileName As String
Dim exportPath As String
Dim ext As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
' Set export path and ensure its existence
exportPath = CurrentProject.path & "\" & CODE_FLD
If Not FSO.FolderExists(exportPath) Then
    MkDir exportPath
End If

' The loop over all modules/classes/forms
For Each c In Application.VBE.VBProjects(1).VBComponents
    ' Get the filename extension from type
    ext = vbExtFromType(c.Type)
    If ext <> "" Then
        fileName = c.name & ext
        debugPrint "Exporting " & c.name & " to file " & fileName
        ' THE export
        c.Export exportPath & "\" & fileName
    Else
        debugPrint "Unknown VBComponent type: " & c.Type
    End If
Next c

End Sub

' Helper function that translates VBComponent types into file extensions
' Returns an empty string for unknown types
Function vbExtFromType(ByVal ctype As Integer) As String
    Select Case ctype
        Case VB_MODULE
            vbExtFromType = EXT_MODULE
        Case VB_CLASS
            vbExtFromType = EXT_CLASS
        Case VB_FORM
            vbExtFromType = EXT_FORM
    End Select
End Function

Only takes a fraction of a second to execute.

Cheers

Answer 4

Lovely answer Clon.

Just a slight variation if you are trying to open MDBs that has a startup form and/or a AutoExec macro and above doesn't always seem to work reliably.

Looking at this answer on another website: By pass startup form / macros and scrolling almost to the end of the discussion is some code which temporarily gets rid of the startup form settings and extracts the AutoExec macro to your database before writing over it with an TempAutoExec macro (which does nothing), does some work (between lines 'Read command bars and app.CloseCurrentDatabase ) and then fixes everything back again.

Answer 5

IDK why no one has suggested this before, but here is a small piece of code I use for this. Pretty simple and straightforward

Public Sub VBAExportModule()
    On Error GoTo Errg
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name FROM MSysObjects WHERE Type=-32761", dbOpenDynaset, dbSeeChanges)

    Do Until rs.EOF
        Application.SaveAsText acModule, rs("Name"), "C:\" & rs("Name") & ".txt"
        rs.MoveNext
    Loop

Cleanup:
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Exit Sub
Errg:
    GoTo Cleanup
End Sub

Answer 6

another way is keep most used code in one external master.mdb and join it to any count of *.mdbs trough Modules->Tools->References->Browse->...\\master.mdb

the only problem in old 97 Access you can Debug, Edit and Save directly in destination.mdb, but in all newer, since MA 2000, 'Save' option is gone and any warnings on close unsaved code

Answer 7

Glad to have found this code, but how do you actually use it. I made the module, but how do I execute it? I tried making a Macro and using "RunCode", but it said the name of my function (ExportAllCode) couldn't be found.