I recently needed to generate a single file containing all the VBA code for a client's Microsoft Access 2003 application. I originally wrote similar code about 8 years ago for Access 2000 but was unable to find it for this project. So, I just decided to write it again and post it for everyone to use. The code generates a header and lie numbers for each module. Enjoy!
Option Compare Database
Option Explicit
Public strAllCode As String
Public Sub StringAllLines()
Dim accObj As AccessObject 'Each module/form/report.
Dim bWasOpen As Boolean 'Flag to leave form/report open if it was open.
Dim strDoc As String 'Name of each form/report
'Stand-alone modules.
For Each accObj In CurrentProject.AllModules
Call GetModuleLines(accObj.Name, True)
Next
'Modules behind forms.
For Each accObj In CurrentProject.AllForms
strDoc = accObj.Name
bWasOpen = accObj.IsLoaded
If Not bWasOpen Then
DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden
End If
If Forms(strDoc).HasModule Then
Call GetModuleLines("Form_" & accObj.Name, False)
End If
If Not bWasOpen Then
DoCmd.Close acForm, strDoc, acSaveNo
End If
Next
'Modules behind reports.
For Each accObj In CurrentProject.AllReports
strDoc = accObj.Name
bWasOpen = accObj.IsLoaded
If Not bWasOpen Then
'In Access 2000, remove the ", WindowMode:=acHidden" from the next line.
DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden
End If
If Reports(strDoc).HasModule Then
Call GetModuleLines("Report_" & accObj.Name, False)
End If
If Not bWasOpen Then
DoCmd.Close acReport, strDoc, acSaveNo
End If
Next
Dim intFile As Integer
'*** Set to next free open number ***
intFile = FreeFile()
Open "c:\AllCode.txt" For Output As #intFile
Print #intFile, strAllCode
Close #intFile
End Sub
Private Function GetModuleLines(strModule As String, bIsStandAlone As Boolean)
Dim bWasOpen As Boolean 'Flag applies to standalone modules only.
Dim lngLineNo As Long
If bIsStandAlone Then
bWasOpen = CurrentProject.AllModules(strModule).IsLoaded
End If
If Not bWasOpen Then
DoCmd.OpenModule strModule
End If
strAllCode = strAllCode & "**********" & vbCrLf
strAllCode = strAllCode & strModule & vbCrLf
strAllCode = strAllCode & "**********" & vbCrLf
For lngLineNo = 1 To Modules(strModule).CountOfLines
strAllCode = strAllCode & Right(" " & lngLineNo, 5) & ": " & Modules(strModule).Lines(lngLineNo, 1) & vbCrLf
Next
strAllCode = strAllCode & vbCrLf & vbCrLf & vbCrLf
If Not bWasOpen Then
On Error Resume Next
DoCmd.Close acModule, strModule, acSaveNo
End If
Debug.Print strModule & " complete"
DoEvents
End Function