How to Extract Wild Card Matches in Word Document using Word VBA / Export Find Matches to Text File using VBA

How to use Word VBA to Find Wild Card Matches in Multiple Word Documents and Extract them 

There are many situations where a particular format throughout the document that needs to be extracted. The answer would be 

1) Wild Card Search
2) Regular expressions

Lets consider wild card search for this post for a document that contains Reference Citations within square brackets [...]

The following snippet Loops through all documents in a folder, opens them and searches for content within Square Brackets 

It exports the matches to a Text File (Can store in Excel also)


Sub Extract_WildCard_Matches()

Dim sWildCard As String
Dim sDir
Dim oWD As Word.Document
Dim sPath As String


sWildCard = "\[[!\[\]]{1,}\]"

sPath = "C:\Documents\"
sDir = Dir$(sPath & "*.docx", vbNormal)

Do Until LenB(sDir) = 0

 Set oWD = Documents.Open(sPath & sDir)

    Open "C:\Match_Output.txt" For Append As #1
    
        Selection.HomeKey wdStory, wdMove
        
        Selection.Find.Execute FindText:=sWildCard, MatchWildcards:=True
        
        Do While Selection.Find.Found
            
            Print #1, ActiveDocument.Name & vbTab & Selection.Range.Text
            
            Selection.Range.Collapse wdCollapseEnd
            
            Selection.Find.Execute
        Loop
        
    Close #1

 oWD.Close False

 sDir = Dir$

Loop




End Sub

Excel VBA - FindAll Method

One out of two code module in Excel VBA will have cells.Find or Findnext method. Here is a generic function - FindAll that can be used to retrieve information of all matching cells.

Function FindAll(ByVal sText As String, ByRef oSht As Worksheet, ByRef sRange As String, ByRef arMatches() As String) As Boolean

' --------------------------------------------------------------------------------------------------------------
' FindAll - To find all instances of the1 given string and return the row numbers.
' If there are not any matches the function will return false
' --------------------------------------------------------------------------------------------------------------

On Error GoTo Err_Trap

Dim rFnd As Range ' Range Object
Dim iArr As Integer ' Counter for Array
Dim rFirstAddress ' Address of the First Find

' -----------------
' Clear the Array
' -----------------
Erase arMatches
Set rFnd = oSht.Range(sRange).Find(What:=sText, LookIn:=xlValues, LookAt:=xlPart)
If Not rFnd Is Nothing Then
rFirstAddress = rFnd.Address
Do Until rFnd Is Nothing
iArr = iArr + 1
ReDim Preserve arMatches(iArr)
arMatches(iArr) = rFnd.Address ' rFnd.Row ' Store the Row where the text is found
Set rFnd = oSht.Range(sRange).FindNext(rFnd)
If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search
Loop
FindAll = True
Else
' ----------------------
' No Value is Found
' ----------------------
FindAll = False
End If


' -----------------------
' Error Handling
' -----------------------
Err_Trap:
If Err <> 0 Then
MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All"
Err.Clear
FindAll = False
Exit Function
End If
End Function

The functions accepts three input parameters - Text To be searched, Worksheet, Search Range and one output Array parameter

The function searches the occurrence of that particular text in the specified range of the Excel Sheet and returns address(es) of all occurrences. The Search is by default part of Excel Cells and not whole cell

Here is a way to implement the function:

Case I : Get Addresses of all matching cells

Sub Drive_The_FindAll_Function()

' Sample Sub to Drive the Function

Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter

bFound = FindAll("SampleText", ActiveSheet, "B1:C41", arTemp())

If bFound = True Then
For i1 = 1 To UBound(arTemp)
' The Address Can be used for extracting data
MsgBox arTemp(i1)
Next i1
Else
MsgBox "Search Text Not Found"
End If



End Sub

Case II : Modify Data according to Find

In the example shown below, FindAll function is used to search 'SampleText' in column C and if the text is found a Flag 'X' is set against column D

Sub Fill_Based_on_FindAll()

' For All Matching Values in Second Column
' Add 'X' to Column D

Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter


bFound = FindAll("SampleText", ActiveSheet, "C:C", arTemp())

If bFound = True Then
For i1 = 1 To UBound(arTemp)
' The Row Number Can be used for extracting data
ActiveSheet.Range(arTemp(i1)).Offset(0, 1).Value = "X"
Next i1
Else
MsgBox "Search Text Not Found"
End If



End Sub

Case III : Get the Number of Occurrences

A simple one though; number of occurrences of the text in particular range

Sub Instances_Based_on_FindAll()

' Get the Number of Instances

Dim arTemp() As String 'Temp Array
Dim bFound As Boolean 'Flag
Dim i1 As Integer 'Array Counter


bFound = FindAll("SampleText", ActiveSheet, "C:C", arTemp())

If bFound = True Then
MsgBox "No of instances : " & UBound(arTemp)
Else
MsgBox "Search Text Not Found"
End If



End Sub