No, you should not need to search through all 400 modules.
If you have functions that have the same names as VBA functions and want to
remove the functions all you need to know is the location (module) of the
same-named function. Then you remove the same named function and the VBA
function will get called.
Personnally, I would comment out the function and then compile. If no error
occurred after the compile, then I would delete the function.
Here is some code that can get you started. Note that is does NOT search
class modules (forms and reports). If you use it as is, you will need to
add a table to your database.
'TableName: tbl_ModuleList
'Fields:
'fldDBName - text
'fldModuleName - text
'fldProcName - text
'fldProcCall - text
'fldComments - Memo
'CODE FOLLOWS
Option Compare Database
Option Explicit
Public Function funListModules()
'*******************************************
'Name: funListModules ()
'Purpose: Open every module in the current database
' and list the names of the Functions and Subroutines
'Author: John Spencer UMBC-CHPDM
'Date: 10/3/2001
'*******************************************
Dim dbs As Database
Dim cntAny As Container
Dim docAny As Document
Dim intCount As Integer
Set dbs = CurrentDb()
Set cntAny = dbs.Containers("Modules")
For intCount = 0 To cntAny.Documents.Count - 1
Set docAny = cntAny.Documents(intCount)
'Debug.Print "Module: " & docAny.Name
If docAny.Name <> "basCrossRef" Then
funListRoutines docAny.Name
End If
Next intCount
Set docAny = Nothing
Set cntAny = Nothing
dbs.Close
Set dbs = Nothing
End Function
Private Function fAddToTable(strDbName, strModule, strProc, _
strCall, strComments)
'Adds procedure information to a table using an SQL statement
Dim strSQL As String, strCall1 As String
Dim strComments1 As String
On Error GoTo fAddtoTable_ERROR
strCall1 = strCall
strComments1 = strComments & ""
strComments1 = ReplaceString(strComments1, Chr(34), Chr(34) & Chr(34)) &
""
If strComments1 = "" Then strComments1 = "No description"
strSQL = "INSERT INTO tbl_ModuleList ( fldDBName, fldModuleName," & _
" fldProcName, fldProcCall, fldComments )" & _
"Values( " & Chr(34) & strDbName & Chr(34) & _
", " & Chr(34) & strModule & Chr(34) & _
", " & Chr(34) & strProc & Chr(34) & _
", " & Chr(34) & ReplaceString(strCall1, Chr(34), Chr(34) & Chr(34)) & _
Chr(34) & _
", " & Chr(34) & strComments1 & Chr(34) & " )"
CurrentDb().Execute strSQL, dbFailOnError
Exit Function
fAddtoTable_ERROR:
MsgBox "Err# " & Err.Number & ": " & Err.Description, , "fAddToTable"
Stop
End Function
Private Function funListRoutines(strModule As String)
'Steps through a module and puts the name of its routines into a
'table along with the initial comments in the routine
Dim modAny As Module
Dim tfModuleOpen As Boolean
Dim lngLineCount As Long, lngCurrentLine As Long, lngProcKind As Long
Dim strProcName As String, strOutput As String, strCurrPosition As String
Dim strDbName As String, strCall As String, strComments As String
strDbName = CurrentDb().Name
strDbName = Dir(strDbName)
If IsModuleOpen(strModule) = False Then
DoCmd.OpenModule strModule
tfModuleOpen = False
Else
tfModuleOpen = True
End If
Set modAny = Modules(strModule)
lngLineCount = modAny.CountOfLines
lngCurrentLine = 1
While lngCurrentLine < lngLineCount
strProcName = modAny.ProcOfLine(lngCurrentLine, lngProcKind)
If strProcName <> "" Then
strOutput = strProcName 'modany.Lines(lngCurrentLine, 1)
While modAny.ProcBodyLine(strProcName, lngProcKind) <>
lngCurrentLine
lngCurrentLine = lngCurrentLine + 1
strOutput = strOutput & vbCrLf & _
Trim(modAny.Lines(lngCurrentLine, 1))
strCall = Trim(modAny.Lines(lngCurrentLine, 1))
Wend
'Get Call string that is continued
While Right(strCall, 1) = "_"
lngCurrentLine = lngCurrentLine + 1
strCall = Left(strCall, Len(strCall) - 1) & _
Trim(modAny.Lines(lngCurrentLine, 1))
Wend
lngCurrentLine = lngCurrentLine + 1
strCurrPosition = Trim(modAny.Lines(lngCurrentLine, 1))
strComments = ""
While InStr(1, Trim(strCurrPosition), "'") = 1
If Trim(ReplaceString(strCurrPosition, "=", "")) = "'" Then
ElseIf Trim(ReplaceString(strCurrPosition, "*", "")) = "'" Then
ElseIf Trim(ReplaceString(strCurrPosition, "-", "")) = "'" Then
Else
strComments = strComments & Trim(Mid(strCurrPosition, 2)) _
& vbCrLf
End If
strOutput = strOutput & vbCrLf & strCurrPosition
lngCurrentLine = lngCurrentLine + 1
strCurrPosition = Trim(modAny.Lines(lngCurrentLine, 1))
Wend
End If
'Output the data
If Len(strProcName) > 0 Then
fAddToTable strDbName, strModule, strProcName, _
strCall & "", strComments & ""
End If
'Step thru lines until we get to a new procedure
'or we get to the end of the module
While strProcName = modAny.ProcOfLine(lngCurrentLine, lngProcKind) _
And lngCurrentLine < lngLineCount
lngCurrentLine = lngCurrentLine + 1
Wend
Wend
funListRoutines_EXIT:
Set modAny = Nothing
If tfModuleOpen = False Then
DoCmd.Close acModule, strModule, acSaveNo
End If
Exit Function
funListRoutines_ERROR:
Stop
End Function
Private Function IsModuleOpen(strModulename As String) As Boolean
'See if a module is already open
Dim modAny As Module
On Error GoTo IsModuleOpen_ERROR
Set modAny = Modules(strModulename)
IsModuleOpen = True
Exit Function
IsModuleOpen_ERROR:
IsModuleOpen = False
End Function
--
John Spencer
Access MVP 2002-2005, 2007
Center for Health Program Development and Management
University of Maryland Baltimore County
..
