How Do I Find All Acronyms in an MS Word Document Using a Macro?

I have a document with many acronyms that need to be captured and put into an acronyms table at the end of the document.

The term acronym has various meanings. I'd like to create a table that has all of the words that are initialized; two or more capitalized letters that are short for a longer meaning. I.e., CD-ROM, USB, SYNC, MMR, ASCAP, etc.

How do I create a macro to do this?

Solution

Something like this might get you started. Add a reference to "Microsoft VBScript Regular Expressions" (Edit Macro: Tools > References). This library is the file, "vbscript.dll".

You may need to adjust the regexp if all your acronyms aren't only upper-case letters (eg some may contain numbers).

Sub Acronyms()

    Dim dict, k, tmp
    Dim regEx, Match, Matches
    Dim rngRange As Range
    Set regEx = New RegExp
    Set dict = CreateObject("scripting.dictionary")

    regEx.Pattern = "[A-Z]{2,}" '2 or more upper-case letters
    regEx.IgnoreCase = False
    regEx.Global = True
    Set Matches = regEx.Execute(ActiveDocument.Range.Text)
    For Each Match In Matches
        tmp = Match.Value
        If Not dict.Exists(tmp) Then dict.Add tmp, 0
        dict(tmp) = dict(tmp) + 1
    Next

    For Each k In dict.Keys
        Debug.Print k, dict(k)
    Next k

End Sub