VBA Module search

  • Thread starter Thread starter DeanT
  • Start date Start date
D

DeanT

We have a large access application which sends an email upon execution of a
certail activity. I am trying to find out what activity triggers the email.
Is there a way I can view all the VBA modules and search for the coding that
triggers the email ?
 
There's really no way to view all modules simultaneously, but the Find
command in the VB Editor can be set to search the entire database.
 
I'm going through my database cleaning it up and adding error trapping and
needed something similar. Trawling the forum I found a couple of suggestions
which I've combined as below. Copy it to a new module then compile and save
it. I run it from the immediate window of the VBA editor as a user will
never need it. I've tried it on A2003 and A2007 and it works OK. No doubt it
could be improved, as it does leave all the VBA modules open in the VBA
editor, but it filled a need, and anyway it's entertaining to watch! I take
NO credit for the code - I just fiddled with it. Credit is due to DC Conlin
and the great Allen Browne.

Cheers,
Bob

(beware of some word-wrapping)

====start of code=====
Function fexportModules(sDestPath As String, Optional sList As Boolean =
True) As Boolean

' this function from an original idea by D C Conlin

' this will output listing of ALL procedures in all modules, forms, and
reports.
' if sList set true (default) will output list of modules to text file
'Module_Listing.txt',
' which can then be printed.
' if sList set false will backup all modules to files *.bas in destination
set by sDestPath

' NOTE: this opens every object and closes them except for standard modules
which remain
' open in VBA editor window.

On Error GoTo ErrHandler

Dim recSet As DAO.Recordset
Dim frm As Form
Dim rpt As Report
Dim sqlStmt As String
Dim sObjName As String
Dim idx As Long
Dim fOpenedRecSet As Boolean
Dim ModFile As String

'--------------------------------------------------------------
' Ensure that there's a backslash at the end of the path.
'--------------------------------------------------------------

If (Mid$(sDestPath, Len(sDestPath), 1) <> "\") Then
sDestPath = sDestPath & "\"
End If

'--------------------------------------------------------------
' Export standard modules and classes.
'--------------------------------------------------------------

ModFile = sDestPath & "Module_Listing.txt"
' if the file exists, delete it.
If sList = True And FileExists(ModFile) Then Kill ModFile

' now open file for output
If sList = True Then
Open ModFile For Output As #1
' output date and time to file at start
Print #1, Now() & vbCrLf
End If

STANDARD:

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32761);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True
If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
If sList = True Then
Print #1, vbCrLf & "STANDARD MODULE"
Print #1, recSet.Fields(0).Value
Print #1, "========================================="
' Debug.Print vbCrLf
' Debug.Print recSet.Fields(0).Value
' Debug.Print "========================================="
fListProc recSet.Fields(0).Value
Else
' backup to .bas file
SaveAsText acModule, recSet.Fields(0).Value, sDestPath &
recSet.Fields(0).Value & ".bas"
End If


If (Not (recSet.EOF)) Then
recSet.MoveNext
End If
Next idx
End If


'--------------------------------------------------------------
' Export form modules.
'--------------------------------------------------------------

FORMS:

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32768);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
sObjName = recSet.Fields(0).Value

DoCmd.OpenForm sObjName, acDesign
Set frm = FORMS(sObjName)

If (frm.HasModule) Then
If sList = True Then
Print #1, vbCrLf & "FORM MODULE"
Print #1, frm.Module
Print #1, "========================================="
' Debug.Print vbCrLf
' Debug.Print frm.Module
' Debug.Print "========================================="
fListProc frm.Module
Else
' backup to .bas file
DoCmd.OutputTo acOutputModule, "Form_" & sObjName,
acFormatTXT, sDestPath & sObjName & ".bas"
End If

End If

DoCmd.Close acForm, sObjName

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If
Next idx
End If


'--------------------------------------------------------------
' Export report modules.
'--------------------------------------------------------------

REPORTS:

sqlStmt = "SELECT [Name] " & _
"FROM MSysObjects " & _
"WHERE ([Type] = -32764);"

Set recSet = CurrentDb().OpenRecordset(sqlStmt)
fOpenedRecSet = True

If (Not (recSet.BOF And recSet.EOF)) Then
recSet.MoveLast
recSet.MoveFirst

For idx = 1 To recSet.RecordCount
sObjName = recSet.Fields(0).Value

DoCmd.OpenReport sObjName, acDesign
Set rpt = REPORTS(sObjName)

If (rpt.HasModule) Then
If sList = True Then
sObjName = recSet.Fields(0).Value
Print #1, vbCrLf & "REPORT MODULE"
Print #1, rpt.Module
Print #1, "========================================="
' Debug.Print vbCrLf
' Debug.Print rpt.Module
' Debug.Print "========================================="
fListProc rpt.Module
Else
' backup to .bas file
DoCmd.OutputTo acOutputModule, "Report_" & sObjName,
acFormatTXT, sDestPath & sObjName & ".bas"
End If

End If

DoCmd.Close acReport, sObjName

If (Not (recSet.EOF)) Then
recSet.MoveNext
End If
Next idx
End If

fexportModules = True ' Success.

If sList = True Then
MsgBox "All modules listed in " & vbCrLf & ModFile
Else
MsgBox "All VBA backed up to " & vbCrLf & sDestPath
End If

CleanUp:

If (fOpenedRecSet) Then
recSet.Close
fOpenedRecSet = False
End If


Close #1
Set frm = Nothing
Set rpt = Nothing
Set recSet = Nothing
Exit Function

ErrHandler:

MsgBox "Error in fexportModules( )." & vbCrLf & vbCrLf & _
"Error #" & Err.number & vbCrLf & vbCrLf & Err.Description
Err.Clear
fexportModules = False ' Failed.
GoTo CleanUp

End Function ' fexportModules( )

Function fListProc(strModuleName As String) As String

' this function lists the procedures in a module passed as strModuleName
' this function from an original idea by Allen Browne

On Error GoTo Err_fListProc


Dim mdl As Module
Dim lngCount As Long
Dim lngCountDecl As Long
Dim lngI As Long
Dim strProcName As String
Dim intI As Integer
Dim strMsg As String
Dim lngR As Long

' Open specified Module object.
DoCmd.OpenModule strModuleName
Set mdl = Modules(strModuleName)

lngCount = mdl.CountOfLines
lngCountDecl = mdl.CountOfDeclarationLines

' Determine name of first procedure.
strProcName = mdl.ProcOfLine(lngCountDecl + 1&, lngR)

intI = 0

'Debug.Print strProcName, lngR
'Debug.Print strProcName
Print #1, strProcName

' Determine procedure name for each line after declarations.
For lngI = lngCountDecl + 1& To lngCount
' Compare procedure name with ProcOfLine property value.
If strProcName <> mdl.ProcOfLine(lngI, lngR) Then
intI = intI + 1&
strProcName = mdl.ProcOfLine(lngI, lngR)
Print #1, strProcName
'Debug.Print strProcName
' Debug.Print , "ProcStartLine = " &
mdl.ProcStartLine(strProcName, lngR)
' Debug.Print , "ProcBodyLine " & mdl.ProcBodyLine(strProcName,
lngR)
' ProcBodyLine is the declaration; ProcStartLine is the
blankspace above procedure.
End If
Next lngI

Exit_fListProc:
Exit Function

Err_fListProc:

MsgBox "Error in fexportModules( )." & vbCrLf & vbCrLf & _
"Error #" & Err.number & vbCrLf & vbCrLf & Err.Description
Err.Clear
GoTo Exit_fListProc

End Function
=====end of code=====
 
Back
Top