If you are involved in the process of reverse engineering a whole suite of VBA applications, you may at some point need to start looking at dependencies hardcoded within the actual code. If you are faced with a large number of applications, documenting these can be a time consuming task.
The following post describes, how you can create your own tool (in Excel) to search the VBA code of other applications to help you with this. It will be an example of how to work with the Visual Basic for Applications Extensibility 5.3 library. The tool will be flexible enough to search the VBA modules within Excel, Access, PowerPoint and Word. It will also tell us of where in the code we can find the search criteria by identifying the module name and line number.
Some considerations
Before we begin, there are a few points to note about this approach:
- We will only be able to search the VBA code in applications that do not have the VBA editor locked. Unfortunately, there is no way to programmatically unlock the VBA editor.
- For some Excel spreadsheets, you will have to make sure that the option “Trust access to the VBA project object model” has been checked. This can be found under the Macro settings option, within Trust Center.
Preliminary Steps
In order to create our tool, we need to make sure we have the right project references in our application. Create a new workbook, and then in the VBA IDE, go to Tools>References and make sure the following references are ticked:
Building the Code
This project will involve creating two classes. There will be a main class called csSearchVBA which carries out the search, and another class called csResults which will hold the details of items found in the search. Having another class to act as a data structure like this, makes it easier to work with the results we get back from the search. All the information we need is encapsulated in this data model, and we don’t need to concern ourselves with the details of where the VBA Extensibility library is pulling the information from. The diagram below gives an overview of the two classes and their relationship:
Let’s now create the classes. First, we are going to create the class to hold the results. Create a new class and call it csResults, and then paste the code below:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 |
Option Explicit Private strSearchValue As String Private strModule As String Private strProcName As String Private strLineOfCode As String Private lngLineNumber As Long Private lngColumnNumber As Long Private lngProcStartLineNumber As Long Private lngProcNumberOfLines As Long Property Let Module(ByVal value As String) strModule = value End Property Property Get Module() As String Module = strModule End Property Property Let ProcName(ByVal value As String) strProcName = value End Property Property Get ProcName() As String ProcName = strProcName End Property Property Let LineOfCode(ByVal value As String) strLineOfCode = value End Property Property Get LineOfCode() As String LineOfCode = strLineOfCode End Property Property Let LineNo(ByVal value As Long) lngLineNumber = value End Property Property Get LineNo() As Long LineNo = lngLineNumber End Property Property Let ColumnNo(ByVal value As Long) lngColumnNumber = value End Property Property Get ColumnNo() As Long ColumnNo = lngColumnNumber End Property Property Let ProcStartLineNo(ByVal value As Long) lngProcStartLineNumber = value End Property Property Get ProcStartLineNo() As Long ProcStartLineNo = lngProcStartLineNumber End Property Property Let ProcNumberOfLines(ByVal value As Long) lngProcNumberOfLines = value End Property Property Get ProcNumberOfLines() As Long ProcNumberOfLines = lngProcNumberOfLines End Property Property Let SearchValue(ByVal value As String) strSearchValue = value End Property Property Get SearchValue() As String SearchValue = strSearchValue End Property |
You can see that the class has no methods, it just has the attributes we are interested in capturing for each search. Next, we are going to create our main class which is going to perform the search. Create another new class called csSearchVBA, and paste the following code in:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 |
Option Explicit Private marrSearchValues() Private mintWordCount As Integer Private mstrFile As String Private mappAccess As Access.Application Private mappWord As Word.Application Private mwrdDoc As Word.Document Private mappPT As PowerPoint.Application Private mpptDoc As PowerPoint.Presentation Private mappExcel As Excel.Application Private mowkb As Workbook Private Const CLNG_ERROR_MSG_LOCKED_PROJECT As Long = 50289 Private Sub Class_Initialize() mintWordCount = 0 End Sub Property Let fileName(ByVal value As String) mstrFile = value End Property Property Get fileName() As String fileName = mstrFile End Property Public Sub clearWords() mintWordCount = 0 ReDim arrSearchValues(0 To mintWordCount) End Sub Public Sub addWord(ByVal value As String) ReDim Preserve marrSearchValues(0 To mintWordCount) marrSearchValues(mintWordCount) = value mintWordCount = mintWordCount + 1 End Sub Public Function GetSearchResults() As Collection On Error GoTo ERR_HANDLER: Dim objFSO As New FileSystemObject Dim objFile As File Dim blnCheckFile As Boolean Set GetSearchResults = Nothing If Len(Dir(mstrFile)) > 0 Then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(mstrFile) Application.StatusBar = "Checking File: " & objFile.Path & " : {" & Now() & "}" Set GetSearchResults = FindSearchValues(objFile) End If EXIT_HERE: Application.StatusBar = Empty Set objFSO = Nothing Set objFile = Nothing Exit Function ERR_HANDLER: Debug.Print Err.Description GoTo EXIT_HERE End Function Private Function FindSearchValues(ByVal oFile As File) As Collection On Error GoTo ERR_HANDLER: Dim VBComp As VBIDE.VBComponent Dim VBCodeMod As VBIDE.CodeModule Dim VBComponentList As VBIDE.VBComponents Dim ProcKind As VBIDE.vbext_ProcKind Dim strProcName As String Dim strModuleName As String Dim lngLineNum As Long Dim lngNumLines As Long Dim lngStartLine As Long Dim lngEndLine As Long Dim lngStartColumn As Long Dim lngEndColumn As Long Dim blnFound As Boolean Dim collResults As New Collection Dim oResult As csResults Dim ltxtCnt As Long Set FindSearchValues = Nothing Set VBComponentList = getVBAComponentList() If VBComponentList Is Nothing Then GoTo EXIT_HERE End If Application.VBE.MainWindow.Visible = False For Each VBComp In VBComponentList DoEvents Select Case VBComp.Type Case vbext_ct_StdModule, vbext_ct_ClassModule, vbext_ct_Document Set VBCodeMod = VBComp.CodeModule strModuleName = VBCodeMod.Name With VBCodeMod For ltxtCnt = LBound(marrSearchValues) To UBound(marrSearchValues) lngStartLine = 1 lngEndLine = .CountOfLines lngStartColumn = 1 lngEndColumn = 255 blnFound = .Find(Target:=marrSearchValues(ltxtCnt), StartLine:=lngStartLine, StartColumn:=lngStartColumn, _ EndLine:=lngEndLine, EndColumn:=lngEndColumn, wholeword:=True, MatchCase:=False, patternsearch:=False) Do Until Not blnFound DoEvents strProcName = .ProcOfLine(lngStartLine, ProcKind) Set oResult = New csResults oResult.SearchValue = marrSearchValues(ltxtCnt) oResult.ProcName = strProcName oResult.Module = strModuleName oResult.LineOfCode = Trim(VBComp.CodeModule.Lines(lngStartLine, 1)) oResult.LineNo = lngStartLine oResult.ColumnNo = lngStartColumn oResult.ProcStartLineNo = .ProcStartLine(strProcName, ProcKind) oResult.ProcNumberOfLines = .ProcCountLines(strProcName, ProcKind) + .ProcStartLine(strProcName, ProcKind) collResults.Add oResult lngEndLine = .CountOfLines lngStartColumn = lngEndColumn + 1 lngEndColumn = 255 blnFound = .Find(Target:=marrSearchValues(ltxtCnt), StartLine:=lngStartLine, StartColumn:=lngStartColumn, _ EndLine:=lngEndLine, EndColumn:=lngEndColumn, wholeword:=True, MatchCase:=False, patternsearch:=False) Loop Next ltxtCnt End With End Select Next VBComp Application.VBE.MainWindow.Visible = True Set FindSearchValues = collResults EXIT_HERE: Call CloseAll Application.VBE.MainWindow.Visible = True Set VBComp = Nothing Set VBCodeMod = Nothing Set VBComponentList = Nothing Set oResult = Nothing Set collResults = Nothing Exit Function ERR_HANDLER: Select Case Err.Number Case CLNG_ERROR_MSG_LOCKED_PROJECT Debug.Print "Locked VBA code" Case Else Debug.Print Err.Description End Select GoTo EXIT_HERE End Function Private Function getVBAComponentList() As VBIDE.VBComponents Dim strFileExt As String Set getVBAComponentList = Nothing If Len(mstrFile) > 0 Then strFileExt = GetExtension(mstrFile) Select Case strFileExt Case "xls", "xlt", "xla", "xlb", "xlb", "xlc", "xld", "xlk", "xll", "xlm", "xlv", "xlw", "xlsm", "xlsb", "xltm", "xlam" Set mappExcel = CreateObject("Excel.Application") Set mowkb = mappExcel.Workbooks.Open(fileName:=mstrFile, UpdateLinks:=False, ReadOnly:=True, local:=True) Set getVBAComponentList = mowkb.VBProject.VBComponents Case "mdb", "accdb", "accdt", "mdn" Set mappAccess = CreateObject("Access.Application") mappAccess.Visible = False mappAccess.OpenCurrentDatabase mstrFile, False Set getVBAComponentList = mappAccess.VBE.ActiveVBProject.VBComponents Case "doc", "docm" Set mappWord = CreateObject("Word.Application") mappWord.Visible = False Set mwrdDoc = mappWord.Documents.Open(fileName:=mstrFile, ReadOnly:=True) Set getVBAComponentList = mappWord.VBE.ActiveVBProject.VBComponents Case "ppt" Set mappPT = CreateObject("PowerPoint.Application") mappPT.Visible = False Set mpptDoc = mappPT.Presentations.Open(fileName:=mstrFile, ReadOnly:=msoTrue) Set getVBAComponentList = mappPT.VBE.ActiveVBProject.VBComponents End Select End If End Function Private Sub CloseAll() If Not mowkb Is Nothing Then mowkb.Close False End If Set mowkb = Nothing If Not mappExcel Is Nothing Then mappExcel.Quit End If Set mappExcel = Nothing If Not mappAccess Is Nothing Then mappAccess.CloseCurrentDatabase mappAccess.Quit End If Set mappAccess = Nothing If Not mappWord Is Nothing Then If Not mwrdDoc Is Nothing Then mwrdDoc.Close False End If Set mwrdDoc = Nothing mappWord.Quit Set mappWord = Nothing End If If Not mappPT Is Nothing Then mappPT.Quit Set mappPT = Nothing End If End Sub Private Function GetExtension(strFileName As String) As String Dim i As Integer Dim strChar As String Dim intPos As Integer For i = Len(Trim(strFileName)) To 1 Step -1 strChar = Mid(Trim(strFileName), i, 1) If strChar = "." Then intPos = i + 1 Exit For End If Next If intPos = 0 Then GetExtension = "#N/A" Else GetExtension = Mid(strFileName, intPos, Len(strFileName) - intPos + 1) End If End Function |
Essentially, these two classes are all that is required for the tool to work. You can create your own frontend for it, as you see fit. But next I will show you how to use the classes to test the process out. Once you understand how to use the classes, then fleshing out the code into an application with a frontend becomes a relatively minor task.
Testing the Application
The code below demonstrates how you can use the tool you have created to search the VBA code of a file that you specify. In the example, the code will search for the words “Hello” and “Goodbye” in the VBA code found within a file called “DummyMacro.xlsm” and it will output the results to the first sheet in the workbook.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
Public Sub TestVBASearch() Dim oSearch As New csSearchVBA Dim coResults As New Collection Dim oResult As csResults Dim lRow As Long oSearch.clearWords oSearch.addWord "Hello" oSearch.addWord "Goodbye" oSearch.fileName = "C:\TEST\DummyMacro.xlsm" Set coResults = oSearch.GetSearchResults If Not coResults Is Nothing Then lRow = 1 For Each oResult In coResults With Sheet1 .Cells(lRow, 1).value = oSearch.fileName .Cells(lRow, 2).value = oResult.Module .Cells(lRow, 3).value = oResult.ProcName .Cells(lRow, 4).value = oResult.LineOfCode .Cells(lRow, 5).value = oResult.LineNo .Cells(lRow, 6).value = oResult.ColumnNo .Cells(lRow, 7).value = oResult.ProcStartLineNo .Cells(lRow, 8).value = oResult.ProcNumberOfLines .Cells(lRow, 9).value = oResult.SearchValue lRow = lRow + 1 End With Next End If Set oSearch = Nothing Set coResults = Nothing Set oResult = Nothing End Sub |
And that’s it, hopefully this will help save you some time having to look through a whole bunch of code for a particular word or phrase.
Thank you for reading this post. Please take time to read the disclaimer about content found on this site.
Share :
