If you’re like me, you might have hundreds, or even thousands of databases and finding VBA code, know what is where might be a challenge to put things lightly.
In the past I provided a procedure to get some information about modules and procedures:
VBA - VBE Enumerate Modules, Procedures and Line Count
It still amazes me how Microsoft can develop these complexe applications but seems to overlook some simple functions that they should included within them to aid developers… But then, as demonstrated with the release of Office 2007 and 2010, Microsoft is not interested in the developer, they are only interested in the end-user’s opinion. Not…
I thought I’d share a slightly modified version . The reason this one can be useful is because you can actually use it to pull information for external databases, not just the current database. I use this type of approach to create an inventory of modules/functions making it much easier to locate things in amongst all my databases, workbooks & documents.
It extracts a list of modules with your VBE projects and further enumerate the various procedures within each module providing information about the name, type, no lines of code, …
The Code
So the code below will generate a listing of summary statistics about every modules (form, report, standard, class) within the database.
'---------------------------------------------------------------------------------------
' Procedure : VBE_GetModuleFunctionInfo
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Enumerate summary information about the Access Database modules and functions
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' oAccess : Access object, for the local database simply use 'Application'
'
' Usage:
' ~~~~~~
' VBE_GetModuleFunctionInfo Application
' Returns -> Result output to the VBE Immediate Window
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2013-06-06
' 2 2023-04-24 Updated Error Handling and CopyRight
'---------------------------------------------------------------------------------------
Sub VBE_GetModuleFunctionInfo(oAccess As Access.Application)
Dim oVBC As Object 'VBComponent
Dim sModuleName As String
Dim sPreviousProcedure As String
Dim sCurrentProcedure As String
Dim sProcedureDeclaration As String
Dim sProcedureType As String
Dim lModuleLineNo As Long
Dim lProcedureNoLines As Long
Dim lProcedureStartLineNo As Long
Dim lPositionComment As Long
Dim lPositionParenthesis As Long
Dim lPk As Long 'vbext_ProcKind
Dim lCounter As Long
Const vbext_pk_Proc As Long = 0
Const vbext_pk_Let As Long = 1
Const vbext_pk_Set As Long = 2
Const vbext_pk_Get As Long = 3
On Error GoTo Error_Handler
'Header for the output in the Immediate Window
Debug.Print "Module", _
"Proc Name", _
"Proc Type", _
"Proc Declaration", _
"Proc No Lines", _
"Proc Start", _
"Proc Act. Start"
Debug.Print String(115, "~")
'Iterate over each module
For lCounter = 1 To oAccess.VBE.VBProjects(1).VBComponents.Count
Set oVBC = oAccess.VBE.VBProjects(1).VBComponents.Item(lCounter)
lModuleLineNo = 1 'Reset the variable for each iteration
sPreviousProcedure = "" 'Reset the variable for each iteration
'Name of the module
sModuleName = oVBC.Name
'Output Module Level Information
Debug.Print sModuleName;
On Error Resume Next 'Some module throw an error with the following line?!
Debug.Print , Switch(Modules(oVBC.CodeModule).Type = acStandardModule, "Standard Module", Modules(oVBC.CodeModule).Type = acClassModule, "Class Module");
If Err.Number <> 0 Then Debug.Print , "Object Module";
Err.Clear
On Error GoTo Error_Handler
Debug.Print , oVBC.CodeModule.CountOfLines
Debug.Print String(50, "-")
'Iterate over each line in the module
For lModuleLineNo = 1 To oVBC.CodeModule.CountOfLines
'Name of the procedure
sCurrentProcedure = oVBC.CodeModule.ProcOfLine(lModuleLineNo, lPk)
'Declaration of the procedure
sProcedureDeclaration = oVBC.CodeModule.Lines(lModuleLineNo, 1)
'Position of the 1st comment character
lPositionComment = InStr(1, sProcedureDeclaration, "'")
'Adjust the sProcedureDeclaration value accordingly to remove the comment portion
If lPositionComment > 0 Then sProcedureDeclaration = Left(sProcedureDeclaration, lPositionComment - 1)
'Position of the 1st parenthesis '(' character
lPositionParenthesis = InStr(1, sProcedureDeclaration, "(")
'Adjust the sProcedureDeclaration value accordingly to remove the argument portion
If lPositionParenthesis > 0 Then sProcedureDeclaration = Left(sProcedureDeclaration, lPositionParenthesis - 1)
'Remove leading/trailing spaces
sProcedureDeclaration = Trim(sProcedureDeclaration)
'Find the 1st line that isn't blank and for which the procedure name has changed (start of the procedure at hand)
If sProcedureDeclaration <> "" And sPreviousProcedure <> sCurrentProcedure Then
'Total no. of lines in the procedure 'section'
lProcedureNoLines = oVBC.CodeModule.ProcCountLines(sCurrentProcedure, lPk)
'Line no. the procedure starts on
lProcedureStartLineNo = oVBC.CodeModule.ProcStartLine(sCurrentProcedure, lPk)
'Extract just the Declaration from the full line
sProcedureDeclaration = Trim(Left(sProcedureDeclaration, Len(sProcedureDeclaration) - Len(sCurrentProcedure)))
'Determine the Type of Procedure
Select Case lPk
Case vbext_pk_Proc
'sProcedureType = "Procedure"
sProcedureType = Switch(InStr(1, sProcedureDeclaration, "Function") > 0, "Function", _
InStr(1, sProcedureDeclaration, "Sub") > 0, "Sub")
Case vbext_pk_Let
sProcedureType = "Property Let"
Case vbext_pk_Set
sProcedureType = "Property Set"
Case vbext_pk_Get
sProcedureType = "Property Get"
Case Else
sProcedureType = "Unknown"
End Select
'Output Procedure Level Information
Debug.Print sModuleName, _
sCurrentProcedure, _
sProcedureType, _
sProcedureDeclaration, _
lProcedureNoLines, _
lProcedureStartLineNo, _
lModuleLineNo
sPreviousProcedure = sCurrentProcedure
End If
Next
Debug.Print
Next
Error_Handler_Exit:
On Error Resume Next
Set oVBC = Nothing
If oAccess.CurrentDb.Name <> Application.CurrentDb.Name Then oAccess.Quit
Exit Sub
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: VBE_GetModuleFunctionInfo" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Sub
Usage Example
To pull a listing you can simple run it by doing:
VBE_GetModuleFunctionInfo Application
which will output a listing like the following to the VBE Immediate window:
Module Proc Name Proc Type Proc Declaration Proc No Lines Proc Start Proc Act. Start ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Module1 Standard Module 170 -------------------------------------------------- Module1 Db_GetApp Function Public Function 36 3 5 Module1 Db_GetApp2 Function Public Function 47 39 40 Module1 VBE_GetModuleInfo Function Public Function 35 86 90 Module1 VBE_GetModuleFunctionInfo2 Function Public Function 50 121 123 clsWB Class Module 19 -------------------------------------------------- clsWB oClsWBButton_OnClick Function Private Function 8 6 8 clsWB Init Sub Public Sub 6 14 16 Form_frm_Db_ProgressBar Object Module 74 -------------------------------------------------- Form_frm_Db_ProgressBar Detail_Click Sub Private Sub 4 42 43 Form_frm_Db_ProgressBar Form_Load Sub Private Sub 29 46 47
So it enumerates the modules indicating the type of module and total number of lines of code and then it breaks down and provides a summary of each procedure within each module providing:
- Procedure’s Name
- Procedure Type
- Procedure’s Declaration
- Total number of lines (can include blank lines, header, …)
- Line number that the VBE considers the start of the procedure (can include blank lines, header, …)
- Actual line number the procedure’s declaration starts at
You can also use something like OpenCurrentDatabase to create an instance to an external db and pass that instance to the procedure to get information about any external database you want.
Room For Further Options
Obviously, this can be further extended. If you have a standard header … then you could extract the version, arguments, … the sky is the limit! You could also push this to a table and create an inventory of all your database modules/procedures and create a lookup form to easily locate code when you need it! (hint hint, that’s what I did)
Extend To Other Applications? Why Of Course!
Furthermore, this code can easily be adapted to work in other applications rather than just Microsoft Access (what it was originally designed for), it is just a question of changing it ever so slightly. Here’s a modified version for use in Excel for instance:
'---------------------------------------------------------------------------------------
' Procedure : VBE_XLS_GetModuleFunctionInfo
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Enumerate summary information about the Excel Workbook modules and functions
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding -> none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' oApp : Access object, for the local database simply use 'Application'
'
' Usage:
' ~~~~~~
' VBE_XLS_GetModuleFunctionInfo ThisWorkbook
' Returns -> Result output to the VBE Immediate Window
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2023-04-24 Updated Error Handling and CopyRight
'---------------------------------------------------------------------------------------
Sub VBE_XLS_GetModuleFunctionInfo(oApp As Object)
Dim oVBC As Object 'VBComponent
Dim sModuleName As String
Dim sPreviousProcedure As String
Dim sCurrentProcedure As String
Dim sProcedureDeclaration As String
Dim sProcedureType As String
Dim lModuleLineNo As Long
Dim lProcedureNoLines As Long
Dim lProcedureStartLineNo As Long
Dim lPositionComment As Long
Dim lPositionParenthesis As Long
Dim lPk As Long 'vbext_ProcKind
Dim lCounter As Long
Const vbext_pk_Proc As Long = 0
Const vbext_pk_Let As Long = 1
Const vbext_pk_Set As Long = 2
Const vbext_pk_Get As Long = 3
On Error GoTo Error_Handler
'Header for the output in the Immediate Window
Debug.Print "Module", _
"Proc Name", _
"Proc Type", _
"Proc Declaration", _
"Proc No Lines", _
"Proc Start", _
"Proc Act. Start"
Debug.Print String(115, "~")
'Iterate over each module
For lCounter = 1 To oApp.VBProject.VBComponents.Count
Set oVBC = oApp.VBProject.VBComponents.Item(lCounter)
lModuleLineNo = 1 'Reset the variable for each iteration
sPreviousProcedure = "" 'Reset the variable for each iteration
'Name of the module
sModuleName = oVBC.Name
'Output Module Level Information
Debug.Print sModuleName;
'Doesn't work in Excel! No such enum
' On Error Resume Next 'Some module throw an error with the following line?!
' Debug.Print , Switch(Modules(oVBC.CodeModule).Type = acStandardModule, "Standard Module", Modules(oVBC.CodeModule).Type = acClassModule, "Class Module");
' If Err.Number <> 0 Then Debug.Print , "Object Module";
' Err.Clear
' On Error GoTo Error_Handler
Debug.Print , oVBC.CodeModule.CountOfLines
Debug.Print String(50, "-")
'Iterate over each line in the module
For lModuleLineNo = 1 To oVBC.CodeModule.CountOfLines
'Name of the procedure
sCurrentProcedure = oVBC.CodeModule.ProcOfLine(lModuleLineNo, lPk)
'Declaration of the procedure
sProcedureDeclaration = oVBC.CodeModule.Lines(lModuleLineNo, 1)
'Position of the 1st comment character
lPositionComment = InStr(1, sProcedureDeclaration, "'")
'Adjust the sProcedureDeclaration value accordingly to remove the comment portion
If lPositionComment > 0 Then sProcedureDeclaration = Left(sProcedureDeclaration, lPositionComment - 1)
'Position of the 1st parenthesis '(' character
lPositionParenthesis = InStr(1, sProcedureDeclaration, "(")
'Adjust the sProcedureDeclaration value accordingly to remove the argument portion
If lPositionParenthesis > 0 Then sProcedureDeclaration = Left(sProcedureDeclaration, lPositionParenthesis - 1)
'Remove leading/trailing spaces
sProcedureDeclaration = Trim(sProcedureDeclaration)
'Find the 1st line that isn't blank and for which the procedure name has changed (start of the procedure at hand)
If sProcedureDeclaration <> "" And sPreviousProcedure <> sCurrentProcedure Then
'Total no. of lines in the procedure 'section'
lProcedureNoLines = oVBC.CodeModule.ProcCountLines(sCurrentProcedure, lPk)
'Line no. the procedure starts on
lProcedureStartLineNo = oVBC.CodeModule.ProcStartLine(sCurrentProcedure, lPk)
'Extract just the Declaration from the full line
sProcedureDeclaration = Trim(Left(sProcedureDeclaration, Len(sProcedureDeclaration) - Len(sCurrentProcedure)))
'Determine the Type of Procedure
Select Case lPk
Case vbext_pk_Proc
'sProcedureType = "Procedure"
sProcedureType = Switch(InStr(1, sProcedureDeclaration, "Function") > 0, "Function", _
InStr(1, sProcedureDeclaration, "Sub") > 0, "Sub")
Case vbext_pk_Let
sProcedureType = "Property Let"
Case vbext_pk_Set
sProcedureType = "Property Set"
Case vbext_pk_Get
sProcedureType = "Property Get"
Case Else
sProcedureType = "Unknown"
End Select
'Output Procedure Level Information
Debug.Print sModuleName, _
sCurrentProcedure, _
sProcedureType, _
sProcedureDeclaration, _
lProcedureNoLines, _
lProcedureStartLineNo, _
lModuleLineNo
sPreviousProcedure = sCurrentProcedure
End If
Next
Debug.Print
Next
Error_Handler_Exit:
On Error Resume Next
Set oVBC = Nothing
Exit Sub
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Source: VBE_XLS_GetModuleFunctionInfo" & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Sub