Search VBA code across multiple Excel files

Question

I have about 100 macros in a folder, and I'm looking for one in particular that contains a VBA module with function called addGBE - I forget WHICH file it's in though. Is there any software program that allows me to search within the VBA code of files in a specific folder?

Answer 1

Make Windows Search look within MS Office and other Compressed files

Starting with Microsoft Office 2007, the Office Open XML (OOXML) file formats have become the default file format.

File types such as .XLSX, .XLSM and .DOCX use XML architecture and ZIP compression to store things like text and formulas into cells that are organized into rows and columns. For example, simply changing a .XLSM' file's extension to.ZIP` allows you to open it as a compressed file and view the files that make up the Excel workbook.

By tweaking a few settings we can ensure that Windows Search always searches within OOXML and other compressed file formats.

_{My example uses Windows 7, but Windows 10 has equivalent settings.}

---

Specify which filetypes should be indexed

• Hit +E an browse to the folder where you keep your Office or Compressed files are stored.

• Hit Alt+T to open the Tools menu and click Folder Options

---

Specify which filetypes to always search within

• Go to the Search tab
• Make sure Always search filenames and contents is selected
• Make sure Include compressed is checked

---

Apply change to other folders:

_{At this point you can either:}

• repeat the above steps on any other folders on which you want to change these options, or,

• go to the View tab and click Apply to Folders to make all folders look/act like the current one.

  Caution! _{This will copy all of the current folder settings to all other folders, including displayed columns, sort order, view, etc., so be aware that you may lose unique setups for individual folders.
  Personally, I'll take the time to setup one folder exactly how I like it, and implement everywhere with a single click.}

Open Indexing Options:

• Hit the Windows Key
• Type index click Indexing Options or hit Enter
• click Modify to open a filetree to specify which folders should be included in the Index.
  I like to include all folders, but this negatively impacts overall performance if you have a ton of data on the drive(s).

In the Indexing Options dialog:

• click the Advanced tab
• in the Advanced Options dialog, go to the File Types tab.

This is where you specify which filetypes the indexer should always search within.

• Go through the list looking for each Open Office XML filetype (like .XLSM and DOCX)
• Select Index Properties and File Contents.
• Repeat for any compressed filetypes you want to include (such as .ZIP and .RAR)
• When finished click OK

]10

---

Force re-index:

When you're finished customizing the Indexing options:

• On the Indexing Options dialog, click Rebuild to build a new index file.

Note that re-indexing can take a really long time to complete, especially if you're actively using the device and/or you have a ton of data stored locally.

You can optionally close the Indexing dialog with the × and the process will continue in the background.

Answer 2

I found some old code (2006) that I've updated. It will open a box to enter search string then open a dir dialog box to select folder. It will then search through all modules and display a msgbox displaying file name and sheet/module name where string was found. I did not make this, just updated. Orig found here. See here for Microsoft documentation on checking for 64bit and declaring data types properly.

    Option Explicit


#If VBA7 And Win64 Then    ' VBA7
Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long


Public Type BROWSEINFO
  hOwner As LongPtr
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As LongPtr
  lParam As LongPtr
  iImage As Long
End Type

#Else    ' Downlevel when using previous version of VBA7

Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
  Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long


Public Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
#End If


Function GetDirectory(Optional Msg) As String

Dim bInfo As BROWSEINFO
Dim Path As String
Dim R As Long
Dim x As Long
Dim pos As Integer

'Root folder (&H0 for Desktop, &H11 for My Computer)
bInfo.pidlRoot = &H0

'Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If

'Type of directory to return
bInfo.ulFlags = &H1

'Display the dialog
x = SHBrowseForFolder(bInfo)

'Parse the result
Path = Space$(512)
R = SHGetPathFromIDList(ByVal x, ByVal Path)
If R Then
pos = InStr(Path, Chr$(0))
GetDirectory = Left(Path, pos - 1)
Else
GetDirectory = ""
End If

End Function

Function RecursiveFindFiles(strPath As String, _
strSearch As String, _
Optional bSubFolders As Boolean = True, _
Optional bSheet As Boolean = False, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As Variant

'adapted from the MS example:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'---------------------------------------------------------------

Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Long 'Number of directories in this strPath.
Dim i As Long 'For-loop counter.
Dim n As Long
Dim arrFiles
Static strStartDirName As String
Static strpathOld As String

On Error GoTo sysFileERR

If lFileCount = 0 Then
Static collFiles As Collection
Set collFiles = New Collection
Application.Cursor = xlWait
End If

If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If

If lFileCount = 0 And lDirCount = 0 Then
strStartDirName = strPath
End If

'search for subdirectories
'-------------------------
nDir = 0

ReDim arrDirNames(nDir)

strDirName = Dir(strPath, _
vbDirectory Or _
vbHidden Or _
vbArchive Or _
vbReadOnly Or _
vbSystem) 'Even if hidden, and so on.

Do While Len(strDirName) > 0
'ignore the current and encompassing directories
'-----------------------------------------------
If (strDirName <> ".") And (strDirName <> "..") Then
'check for directory with bitwise comparison
'-------------------------------------------
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
DoEvents
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont1:
End If
strDirName = Dir() 'Get next subdirectory

DoEvents
Loop

'Search through this directory
'-----------------------------
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)

While Len(strFileName) <> 0

'dump file in sheet
'------------------
If bSheet Then
If lFileCount < 65536 Then
Cells(lFileCount + 1, 1) = strPath & strFileName
End If
End If

lFileCount = lFileCount + 1

collFiles.Add strPath & strFileName

If strPath <> strpathOld Then
Application.StatusBar = " " & lFileCount & _
" " & strSearch & " files found. " & _
"Now searching " & strPath
End If

strpathOld = strPath

strFileName = Dir() 'Get next file

DoEvents
Wend

If bSubFolders Then
'If there are sub-directories..
'------------------------------
If nDir > 0 Then
'Recursively walk into them
'--------------------------
For i = 0 To nDir - 1
RecursiveFindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
bSubFolders, _
bSheet, _
lFileCount, _
lDirCount

DoEvents
Next
End If 'If nDir > 0

'only bare main folder left, so get out
'--------------------------------------
If strPath & arrDirNames(i) = strStartDirName Then
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If

Else 'If bSubFolders
ReDim arrFiles(1 To lFileCount) As String
For n = 1 To lFileCount
arrFiles(n) = collFiles(n)
Next
RecursiveFindFiles = arrFiles
Application.Cursor = xlDefault
Application.StatusBar = False
End If 'If bSubFolders

Exit Function
sysFileERR:

Resume sysFileERRCont1

End Function

Function FileFromPath(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean = False) _
As String

Dim FPL As Long 'len of full path
Dim PLS As Long 'position of last slash
Dim pd As Long 'position of dot before exension
Dim strFile As String

On Error GoTo ERROROUT

FPL = Len(strFullPath)
PLS = InStrRev(strFullPath, "\", , vbBinaryCompare)
strFile = Right$(strFullPath, FPL - PLS)

If bExtensionOff = False Then
FileFromPath = strFile
Else
pd = InStr(1, strFile, ".", vbBinaryCompare)
FileFromPath = Left$(strFile, pd - 1)
End If

Exit Function
ERROROUT:

On Error GoTo 0
FileFromPath = ""

End Function

Sub SearchWBsForCode()

Dim strTextToFind As String
Dim strFolder As String
Dim arr
Dim i As Long
Dim strWB As String
Dim VBProj As VBProject
Dim VBComp As VBComponent
Dim lStartLine As Long
Dim lEndLine As Long
Dim lFound As Long
Dim lType As Long
Dim lSkipped As Long
Dim oWB As Workbook
Dim bOpen As Boolean
Dim bNewBook As Boolean

strTextToFind = InputBox("Type the text to find", _
"finding text in VBE")

If Len(strTextToFind) = 0 Or StrPtr(strTextToFind) = 0 Then
Exit Sub
End If

strFolder = GetDirectory()

If Len(strFolder) = 0 Then
Exit Sub
End If

lType = Application.InputBox("Type file type to search" & _
vbCrLf & vbCrLf & _
"1. Only .xls files" & vbCrLf & _
"2. Only .xla files" & vbCrLf & _
"3. Either file type", _
"finding text in VBE", 1, Type:=1)

Select Case lType
Case 1
arr = RecursiveFindFiles(strFolder, "*.xls", True, True)
Case 2
arr = RecursiveFindFiles(strFolder, "*.xla", True, True)
Case 3
arr = RecursiveFindFiles(strFolder, "*.xl*", True, True)
Case Else
Exit Sub
End Select

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

For i = 1 To UBound(arr)

Application.StatusBar = i & "/" & UBound(arr) & _
" - Searching " & arr(i)

strWB = FileFromPath(arr(i))

On Error Resume Next
Set oWB = Workbooks(strWB)

If oWB Is Nothing Then
bOpen = False
Workbooks.Open arr(i)
Else
'for preventing closing WB's that are open already
bOpen = True
Set oWB = Nothing
End If

bNewBook = True

For Each VBComp In Workbooks(strWB).VBProject.VBComponents

If Err.Number = 50289 Then 'for protected WB's
lSkipped = lSkipped + 1
Err.Clear
GoTo PAST
End If

lEndLine = VBComp.CodeModule.CountOfLines
If VBComp.CodeModule.Find(strTextToFind, _
lStartLine, _
1, _
lEndLine, _
-1, _
False, _
False) = True Then

If bNewBook = True Then
lFound = lFound + 1
bNewBook = False
End If

Application.ScreenUpdating = True

If MsgBox("Workbook: " & arr(i) & vbCrLf & _
"VBComponent: " & VBComp.Name & vbCrLf & _
"Line number: " & lStartLine & _
vbCrLf & vbCrLf & _
"WB's found so far: " & lFound & vbCrLf & _
"Protected WB's skipped: " & lSkipped & _
vbCrLf & vbCrLf & _
"Stop searching?", _
vbYesNo + vbDefaultButton1 + vbQuestion, _
i & "/" & UBound(arr) & _
" - found " & strTextToFind) = vbYes Then

With Application
.StatusBar = False
.EnableEvents = True
.DisplayAlerts = True
End With

With VBComp.CodeModule.CodePane
.SetSelection lStartLine, 1, lStartLine, 1
.Show
End With

Exit Sub
End If

Application.ScreenUpdating = False

End If
Next

PAST:
If bOpen = False Then
Workbooks(strWB).Close savechanges:=False
End If
On Error GoTo 0

Next

On Error Resume Next
If bOpen = False Then
Workbooks(strWB).Close savechanges:=False
End If

With Application
.ScreenUpdating = True
.StatusBar = False
.EnableEvents = True
.DisplayAlerts = True
End With

MsgBox lFound & " WB's found with " & strTextToFind & " in VBE" & _
vbCrLf & vbCrLf & _
"protected WB's skipped: " & lSkipped, , _
"finding text in VBE"

End Sub