How can I use VBA to search all modules for a text string
Dim response As Integer, mdl As Module, obj As AccessObject
Dim Totallines As Long, PrStartLine As Long, PrBodyline As Long
Dim PrLines As Long, Lno As Long, ok As Boolean, thisLine As Long
Dim MdlName As String, PrName As String, PrType As Long, s As String
Dim PrLastLine As Long, LineCounter As Long, ColCode As Integer
Dim PrPrevious As String, sx As String, skipflg As Boolean
Dim PrTpPrevious As Long
Const cstEndProcCode = "/End Sub/End Function/End Property"
On Error GoTo ErrHandler
'we scan the code modules
For Each obj In Application.CurrentProject.AllModules
MdlName = obj.Name
If not obj.IsLoaded Then DoCmd.OpenModule MdlName
'set a module variable
Set mdl = Application.Modules(MdlName)
'do the work
GoSub McbDoIt
'and close it
DoCmd.Close acModule, MdlName, acSaveYes
End If
Next
'we do the same for the forms
For Each obj In Application.CurrentProject.AllForms
MdlName = obj.Name
If not obj.IsLoaded Then DoCmd.OpenForm MdlName, acDesign
If Forms(MdlName).HasModule Then
Set mdl = Forms(MdlName).Module
GoSub McbDoIt
End If
DoCmd.Close acForm, MdlName, acSaveYes
End If
Next
'and again for the reports
For Each obj In Application.CurrentProject.AllReports
MdlName = obj.Name
If not obj.IsLoaded Then DoCmd.OpenReport MdlName, acViewDesign
If Reports(MdlName).HasModule Then
Set mdl = Reports(MdlName).Module
GoSub McbDoIt
End If
DoCmd.Close acReport, MdlName, acSaveYes
Next
End If
ExitHere:
Exit Sub
ErrHandler:
' for your error goto
resume exitHere
McbDoIt:
' here comes the real work
'we initialize the linecounter
LineCounter = lineIncrement
'total number of lines in the module
Totallines = mdl.CountOfLines - 1
'we begin at the first line after declaration lines
Lno = mdl.CountOfDeclarationLines + 1
PrPrevious = "." ' this is an illegal module name
Do
Do
'we look for the first procedure name
PrName = mdl.ProcOfLine(Lno, PrType)
If PrName <> PrPrevious Or PrType <> PrTpPrevious Then Exit Do
'if for any reason it's still the same procedure then check next
line
Lno = Lno + 1
Loop
If Len(PrName) = 0 Then Exit Do 'no procedure in this module
'f.i. only API definitions, if we don't test access crashes
PrPrevious = PrName
PrTpPrevious = PrType
' for next 4 lines refer to the VBA help file
PrStartLine = mdl.ProcStartLine(PrName, PrType)
PrBodyline = mdl.ProcBodyLine(PrName, PrType)
PrLines = mdl.ProcCountLines(PrName, PrType)
PrLastLine = (PrBodyline + PrLines - 1) _
- Abs(PrBodyline - PrStartLine)
'now we scan the procedure lines
For thisLine = PrBodyline To PrLastLine
'load the line
s = mdl.Lines(thisLine, 1)
sx = Trim$(s)
'some lines should not be processed
'remmed, splitted, labels and end procedures
If skipflg Then
skipflg = False 'if skipped reset the skip flag
ElseIf thisLine = PrBodyline Or _
Left$(sx, 1) = "'" Or _
Right$(sx, 1) = ":" Or _
InStr(cstEndProcCode, "/" & Left$(sx, 7)) > 0 Then
Else
'skip over line numbers
For ColCode = 1 To Len(s)
If InStr("1234567890", Mid$(s, ColCode, 1)) = 0 Then _
Exit For
Next
'+++++++++++++++++++++++++++++++
'+ Here you put your string search code +
'+++++++++++++++++++++++++++++++
'if you want to replace the line then use the next line
' =====> mdl.ReplaceLine thisLine, s
End If
End If
Next
'sets the line number to find next procedure
Lno = PrLastLine + 1
'just in case we have blank lines f.ex. at end of a module
'you never know beter be carefull
Do
sx = Trim$(mdl.Lines(Lno, 1))
If Len(sx) > 0 Then Exit Do
Lno = Lno + 1
Loop While Lno < Totallines
Loop While Lno < Totallines
'work is done
Return
Quote:
> Thanks in advance,
> Augie
