Acronym Macro to include surrounding text

SerenityNetworks · #1 03-02-2016, 09:04 AM

I use the following macro to extract acronyms from various documents.

https://www.msofficeforums.com/word/...-acronyms.html

I'd like to expand the macro so that it captures the text before and after the discovered acronym and pastes it into the document following the page number. The documents I work with do not follow any standard convention on how acronyms are defined, such as within parenthesis with the definition immediately preceding. So I'd just like to capture a range of text before and after the acronym. It could be 'n' sentences before and after (as defined by periods) or simply a variable for 'n' characters before and after. I'm not particular. Sentences would be nice, but characters is fine if it is easier to code.

I'm not a coder, so I'd need someone to provide me the code to use.

Any help will be greatly appreciated.

Thanks in advance,
Andrew

SerenityNetworks · #2 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

macropod · #3 03-07-2016, 01:55 PM

Try something along the lines of:

Code:

Sub Demo()
Dim oCol As New Collection
Dim oColPN As New Collection
Dim oRng As Word.Range
Dim RngTmp As Word.Range
Dim oDoc As Word.Document
Dim lngIndex As Long
Set oRng = ActiveDocument.Range
With oRng.Find
  .Text = "<[A-Z]{1,5}>"
  .MatchWildcards = True
  While .Execute
    On Error Resume Next
    Set RngTmp = oRng.Paragraphs.First.Range
    With RngTmp
      .End = .End - 1
    End With
    oCol.Add oRng.Text & vbTab & RngTmp.Text, oRng.Text
    If Err.Number = 0 Then
      oColPN.Add oRng.Information(wdActiveEndPageNumber)
    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
Next lngIndex
End Sub

macropod · #4 03-11-2016, 05:43 PM

Cross-posted at: http://www.vbaexpress.com/forum/show...found-acronyms)
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Acronym Finder Macro for Microsoft Word	mars1886	Word VBA	15	03-30-2022 06:56 AM
Asking about In Text Pictures, and Text surrounding	azbaby543	Word	0	02-25-2016 11:22 AM
Pasting tables inserts unwanted white space in surrounding text	velour99	Word	1	07-22-2015 11:39 AM
Word 2003 - IncludeText Does Not Include Bookmark Text if in a Form Text Control	skarden	Word	1	12-12-2011 10:39 PM
creating border to image without surrounding text	gib65	Drawing and Graphics	5	08-15-2011 09:17 AM