Microsoft Office Forums - View Single Post - [Solved] Acronym Macro to include surrounding text

SerenityNetworks · 03-07-2016, 12:30 PM

I'm trying to figure this out, but I'm having no substantial success. I can use the following, but it only grabs the sentence after the first acronym found and then repeats it for every acronym. At the very least I need to return the sentence where the acronym appears, not the sentence after.

I'd really appreciate any help.

Thanks,
Andrew

Code:

Sub GetAcronyms()
'A basic Word macro coded by Greg Maxey
'https://www.msofficeforums.com/word/17843-macro-create-list-acronyms.html
Dim oCol As New Collection
Dim oColPN As New Collection
 Dim oColTxt As New Collection 'new
 Dim strTxt As String 'new
Dim oRng As Word.Range
Dim oDoc As Word.Document
Dim lngIndex As Long
Set oRng = ActiveDocument.Range
With oRng.Find
  .Text = "<[A-Z]{1,4}>"
  .MatchWildcards = True
    
    'new
    With Selection
    ' Expand selection to current sentence.
    .Expand Unit:=wdSentence
    End With
    strTxt = Selection.Text
    
  While .Execute
    On Error Resume Next
    oCol.Add oRng.Text, oRng.Text
    'Uncomment the following to add the page number of the acronym.  Also swap commented row near bottom.
        If Err.Number = 0 Then
          oColPN.Add oRng.Information(wdActiveEndPageNumber)
         
          oColTxt.Add strTxt 'new
          
        End If
    On Error GoTo 0
    oRng.Collapse wdCollapseEnd
  Wend
End With
Set oDoc = Documents.Add
For lngIndex = 1 To oCol.Count
  'oDoc.Range.InsertAfter oCol(lngIndex) & " " & oColPN(lngIndex) & vbCr 'original
  oDoc.Range.InsertAfter oCol(lngIndex) & vbTab & oColPN(lngIndex) & vbTab & oColTxt(lngIndex) & vbCr
  'oDoc.Range.InsertAfter oCol(lngIndex) & vbCr
Next lngIndex
End Sub