Find text in word document using VBA

Hi Experts,

I have hundred plus word documents. What i want is to write a simple VBA program to list out distinct text with "[]" in each document. E.g.

I was not born in [New York], instead I was born in [LA], but I'm moving from [LA] to [New York]. But I love [San Francisco] the most.

The result should be:
New York
San Francisco

Please help. This is very urgent! If not, I will have to go through the hundred documents...

Many Thanks.
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Try using the maxcro recorder, and record a macro to perform a search for the words you are looking for.

then edit the macro to pass a true/false value, and read the file name property if true.

I am not very familiar with vba in word, but I also believe that vba can read the file names in a directory, and could therefore open them one by one, test for the presence of the search words, record the file name of test = true files in an array, and print the array to a spreadsheet, doc file or paper.

can anyone else add details?
LizzJAuthor Commented:

You've got the idea half correct. I only want those text enclosed with square brackets, but i don't know exactly what those text are, so don't think macro can achieve this.

I found the following solution from a similar question just now. And now i'm able to search for the first content i want. But exactly, like what you mentioned, to loop through the whole document and also all these 100 documents one by one and print the text in a spreadsheet?

            With Selection.Find
                 .Text = "["
                 .Replacement.Text = ""
                 .Forward = True
                 .Wrap = wdFindContinue
             End With
            With Selection
                .StartIsActive = False
                .Extend Character:="]"
            End With
            Set rngHereIAm = Selection.Range
            'Ref = rngHereIAm.Text ' This would get the contents with the brackets
            Ref = Mid(rngHereIAm.Text, InStr(rngHereIAm.Text, "[") + 1, _
            (InStr(rngHereIAm.Text, "]") - (InStr(rngHereIAm.Text, "[") + 1)))
            Debug.Print Ref
            Ref = ""
            Set rngHereIAm = Nothing

Open in new window

Put all the files in a single folder and try this macro:
Option Explicit

Sub FindingText()
    Dim doc As Document
    Dim rng As Range
    Dim docA As Document
    Dim strFile As String
    Const strFolder = "C:\MyFolder"
    Set docA = Documents.Add
    strFile = Dir$(strFolder & "\" & "*.doc*")
    Application.ScreenUpdating = False
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & "\" & strFile)
        docA.Bookmarks("\EndOfDoc").Range.Text = strFile & vbCr
        docA.Paragraphs.Last.Previous.Style = "Heading 1"
        Set rng = doc.Range
        Do While True
            With rng.Find
                .Text = "\[*\]"
                .MatchWildcards = True
                If .Execute Then
                    rng.MoveStart wdCharacter, 1
                    rng.MoveEnd wdCharacter, -1
                    docA.Bookmarks("\EndOfDoc").Range.Text = rng.Text & vbCr
                    docA.Paragraphs.Last.Previous.Style = "Normal"
                    docA.Bookmarks("\EndOfDoc").Range.Text = vbCr
                    docA.Paragraphs.Last.Previous.Style = "Normal"
                    Exit Do
                End If
                rng.MoveEnd wdCharacter, 1
                rng.Collapse wdCollapseEnd
            End With
        doc.Close wdDoNotSaveChanges
        strFile = Dir$()
    Application.ScreenUpdating = True
End Sub

Open in new window


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LizzJAuthor Commented:

This works perfect. Thanks a lot!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.