Searching Files in Subfolders for VBA code string
We have an unwritten rule where I work which goes: No major changes on a Friday!
Being a Friday (NZDT), it was a good day for housekeeping the systems I look after.
There were a few database Views which I've been wanting to tidy up. These particular Views kind of got "out of control" so I had to hunt down all the places where they were used.
Unfortunately, the locations were never registered.
Fortunately, it's use was limited to ADO calls from within Excel code modules. All of the files were in the same Folder - buried under several layers of subfolders.
Here is a bit of code which opens each XL file in a folder (and subfolders), checks each code module for a string and when found reports: FileName, ModuleName, LineNumber
'Needs a reference to Microsoft Visual Basic for Applications Extensibility
Sub XLS_Files_Search_Code_For_String()
Const cFolder = "C:Documents and SettingsOwnerMy Documents" 'there should be slashes here
Const cFile = "*.xl*"
Const cTarget = "MyView_VW"
Dim i As Long, rng As Range, wkb As Workbook, vbc As VBComponent
Dim strFile As String, lngStartLine As Long, lngStartCol As Long
Dim xCalc As XlCalculation, blnEvents As Boolean
Set rng = Selection(1) 'currently selected cell is where the results will be placed
With Application.FileSearch
.NewSearch
.LookIn = cFolder
.Filename = cFile
.SearchSubFolders = True
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute()> 0 Then
'Store old Calculation and Events state
xCalc = Application.Calculation
Application.Calculation = xlCalculationManual
blnEvents = Application.EnableEvents
Application.EnableEvents = False
On Error GoTo errwkb
For i = 1 To .FoundFiles.Count
strFile = .FoundFiles(i)
If ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name <> strFile Then
Set wkb = Workbooks.Open(Filename:=strFile, UpdateLinks:=0, ReadOnly:=True)
'Inspect each VB component for Target string
For Each vbc In wkb.VBProject.VBComponents
lngStartLine = 1: lngStartCol = 1
Do Until Not vbc.CodeModule.Find(cTarget, lngStartLine, lngStartCol, -1, -1)
'Target string was found
rng.Value = strFile
rng.Offset(0, 1).Value = vbc.Name
rng.Offset(0, 2).Value = lngStartLine
Set rng = rng.Offset(1, 0)
lngStartCol = lngStartCol + 1
Loop
Next
wkb.Close SaveChanges:=False
End If
reswkb:
Next
On Error GoTo 0
'Restore Calculation and Events state
Application.Calculation = xCalc
Application.EnableEvents = blnEvents
Else
MsgBox "There were no files found."
End If
End With
Exit Sub
errwkb:
rng.Value = strFile
rng.Offset(0, 1).Value = "Error: " & Err.Description
Set rng = rng.Offset(1, 0)
Resume reswkb
End Sub
Sub XLS_Files_Search_Code_For_String()
Const cFolder = "C:Documents and SettingsOwnerMy Documents" 'there should be slashes here
Const cFile = "*.xl*"
Const cTarget = "MyView_VW"
Dim i As Long, rng As Range, wkb As Workbook, vbc As VBComponent
Dim strFile As String, lngStartLine As Long, lngStartCol As Long
Dim xCalc As XlCalculation, blnEvents As Boolean
Set rng = Selection(1) 'currently selected cell is where the results will be placed
With Application.FileSearch
.NewSearch
.LookIn = cFolder
.Filename = cFile
.SearchSubFolders = True
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute()> 0 Then
'Store old Calculation and Events state
xCalc = Application.Calculation
Application.Calculation = xlCalculationManual
blnEvents = Application.EnableEvents
Application.EnableEvents = False
On Error GoTo errwkb
For i = 1 To .FoundFiles.Count
strFile = .FoundFiles(i)
If ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name <> strFile Then
Set wkb = Workbooks.Open(Filename:=strFile, UpdateLinks:=0, ReadOnly:=True)
'Inspect each VB component for Target string
For Each vbc In wkb.VBProject.VBComponents
lngStartLine = 1: lngStartCol = 1
Do Until Not vbc.CodeModule.Find(cTarget, lngStartLine, lngStartCol, -1, -1)
'Target string was found
rng.Value = strFile
rng.Offset(0, 1).Value = vbc.Name
rng.Offset(0, 2).Value = lngStartLine
Set rng = rng.Offset(1, 0)
lngStartCol = lngStartCol + 1
Loop
Next
wkb.Close SaveChanges:=False
End If
reswkb:
Next
On Error GoTo 0
'Restore Calculation and Events state
Application.Calculation = xCalc
Application.EnableEvents = blnEvents
Else
MsgBox "There were no files found."
End If
End With
Exit Sub
errwkb:
rng.Value = strFile
rng.Offset(0, 1).Value = "Error: " & Err.Description
Set rng = rng.Offset(1, 0)
Resume reswkb
End Sub
Beautiful, Rob.
I thought this was elegant:
Set rng = rng.Offset(1, 0)
Joseph,
I could have gone: Set rng = rng(2)
but I'm not a big fan of that method because I believe it reduces readability.
That said, I still use it sometimes...
Set rng = Selection(1)
Cheers,
Rob
When I run the code, I get an error saying that "Programmatic access to Visual Basic Project is not trusted".
Is there a security setting that I need to change?
Matt
You need to do the following. On the menu go to Tools\Macro\Security, select the "Trusted Publishers" tab and check the option "Trust access to Visual Basic Project" and the code should run. I'm using Excel 2003 but as far as i'm aware it should be the same process in 2000 and 2002.
John
Looks like FileSearch is gone in Excel 2007!
josh
Hi,
Nice blog, thanks. I'm trying to find a file that has all the Excel enumerations set out - something like a header or some other "include" thing.
So far unsuccessful - any hints?
Cheers.
Grant