(Solved) – Copying multiple matches from documents in nested folders into excel – VB


Hello & thanks in advance for any help.

My situation:

Multiple (unknown quantity) Word files in multiple (unknown qty) folders, all contained in a Master folder. Want to be able to scan all the Word files for a specific text pattern (##?##?## – six digit number with spaces, -, or _ between pairs), copy that pattern and paste it into a separate document (the document the macro is run from, it could be Word or Excel it doesn’t matter) when it appears.

I have this code so far, slightly modified from another question on here:

Sub CheckCrossRef()
Dim strFolder As String
Dim strDoc As String
Dim wordApp As Word.Application
Dim wordDoc As Word.document

Set wordApp = New Word.Application
wordApp.Visible = True

Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    .Title = "Select the folder that contains the documents."
    If .Show = -1 Then
        strFolder = .SelectedItems(1) & ""
        MsgBox "You did not select the folder that contains the documents."
        Exit Sub
    End If
End With

MkDir strFolder & "Processed"

strDoc = Dir$(strFolder & "*.docx")
While strDoc <> ""
    Set wordDoc = Word.Documents.Open(strFolder & strDoc)
    With wordDoc
        With wordApp.Selection.Find
            .Text = "[0-9]{2}?[0-9]{2}?[0-9]{2}"
            .MatchWildcards = True
            .wrap = wdFindContinue
        End With
    End With
    strDoc = Dir$()

Set wordApp = Nothing
End Sub

In my mind I still need:

  • to handle the nested folders (would it be easiest to create a “scratch” folder within the code where all the word documents are copy-pasted into and then scan that folder for documents? There are probably typically ~300 documents, all simple text Word docs)
  • create range (?) for the text match, copy and paste onto list

Addl. questions:

  • with wdFindContinue set, this should be capable of finding multiple matches, correct?
  • If there are no matches (which is possible), will this cause an error?


Leave a Reply

Your email address will not be published. Required fields are marked *