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