Sub FindPatternMatchedFiles()
Dim oFSO As Object
Dim oRegExp As Object
Dim varFile As Variant
Dim colFiles As Collection
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oRegExp = CreateObject("VBScript.RegExp")
  oRegExp.Pattern = ".*do[ct][mx]"
  oRegExp.IgnoreCase = True
  Set colFiles = New Collection
  RecursiveFileSearch "D:\My Documents\Word\Word Documents\Invoices", oRegExp, colFiles, oFSO
  For Each varFile In colFiles
 
    If Not varFile = "test.docm" Then
      Debug.Print varFile
      'Insert code here to do something with the matched files
    End If
 
  Next
  'Garbage Collection
  Set oFSO = Nothing
  Set oRegExp = Nothing
End Sub
 
Sub RecursiveFileSearch(ByVal strFolder As String, ByRef oRegExp As Object, _
                    ByRef colMatched As Collection, ByRef oFSO As Object)
 
Dim oFolder As Object
Dim oFile As Object
Dim oSubFolder As Object
Dim objSubFolder As Object
  'Get the folder object associated with the target directory
  Set oFolder = oFSO.GetFolder(strFolder)
  'Loop through the files current folder
  For Each oFile In oFolder.Files
    If oRegExp.test(oFile) Then
      colMatched.Add (oFile)
    End If
  Next
  'Loop through the each of the sub folders recursively
  Set oSubFolder = oFolder.Subfolders
  For Each objSubFolder In oSubFolder
    RecursiveFileSearch objSubFolder, oRegExp, colMatched, oFSO
  Next
  Set oFolder = Nothing
  Set oFile = Nothing
  Set oSubFolder = Nothing
End Sub