Exporting MS Access Forms and Class / Modules Recursively to text files? Exporting MS Access Forms and Class / Modules Recursively to text files? vba vba

Exporting MS Access Forms and Class / Modules Recursively to text files?


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 inVBE > 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 cEnd Sub


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 ExplicitOption Compare Database'Save the code for all modules to files in currentDatabaseDir\CodePublic 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 functionSaveToFile_Err:   MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)   Resume SaveToFile_ExitEnd 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 SuberrHandler:    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf    Stop: ResumeEnd 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 addFolderEnd 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 IfNext'' 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 intFileEnd 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 SuberrHandler:   MsgBox Err.Description, vbCritical + vbOKOnlyEnd Sub


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 = 1Const VB_CLASS = 2Const VB_FORM = 100Const EXT_MODULE = ".bas"Const EXT_CLASS = ".cls"Const EXT_FORM = ".frm"Const CODE_FLD = "Code"Sub ExportAllCode()Dim fileName As StringDim exportPath As StringDim ext As StringDim FSO As ObjectSet FSO = CreateObject("Scripting.FileSystemObject")' Set export path and ensure its existenceexportPath = CurrentProject.path & "\" & CODE_FLDIf Not FSO.FolderExists(exportPath) Then    MkDir exportPathEnd If' The loop over all modules/classes/formsFor 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 IfNext cEnd Sub' Helper function that translates VBComponent types into file extensions' Returns an empty string for unknown typesFunction 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 SelectEnd Function

Only takes a fraction of a second to execute.

Cheers