I have a 100+ page Word document, that I would like to extract all of the underlined words from. I am very familiar with VBA and Excel, but relatively new to Word. I was wondering if this is the best way to do what I'm trying.
I will run this from my Word document:
Sub extractUnderlinedWords() Dim thisDoc As Word.Document Application.ScreenUpdating = False Dim appExcel As Object, oxlWbk As Object Dim FN As String Dim aRange As Range Dim intRowCount As Integer intRowCount = 1 Set thisDoc = ActiveDocument Set aRange = thisDoc.Range Set appExcel = CreateObject("Excel.application") FN = "C:\Users\[blah]\UnderlinedWords.xlsx" If FileExists(FN) Then Set oxlWbk = appExcel.workbooks.Open(fileName:=FN).Sheets("Sheet1") End If With aRange.Find Do .Font.Underline = True .Execute If .Found Then ' aRange.Expand Unit:=wdSentence ' aRange.Select If Len(aRange) > 1 Then If Not aRange.InRange(thisDoc.TablesOfContents(1).Range) Then aRange.MoveEndWhile cset:=Chr(13), Count:=wdBackward ' aRange.Copy oxlWbk.Cells(intRowCount, 1).Value = aRange.Text aRange.Collapse wdCollapseEnd Debug.Print "Page: " & aRange.Information(wdActiveEndAdjustedPageNumber) ' aRange.Select If oxlWbk Is Nothing Then intRowCount = 1 End If 'oxlWbk.Cells(intRowCount, 1).Value = aRange.Text ' oxlWbk.Paste intRowCount = intRowCount + 1 End If End If End If Loop While .Found End With If Not oxlWbk Is Nothing Then appExcel.workbooks(1).Close True appExcel.Quit Set oxlWbk = Nothing Set appExcel = Nothing End If Set aRange = Nothing Application.ScreenUpdating = True MsgBox ("Done!") End Sub
This does work, but after about page 14, it hangs up and "freezes" on me. Pressing CTRL+BREAK does nothing, except "unfocus" the application.
Should I instead, add all found words to an Array, then after it's done scanning the Word document, focus on Excel and outputting the parts of array row by row? I think perhaps what's causing the freeze is the jumping back and forth from Word to Excel. (Or, could it be that I'm using a
Again, the idea is to take all underlined words and put in an Excel sheet for reviewing.
Edit: I'm not married to the Excel idea. In the end I need it in Excel, but if there are other ideas (perhaps send data to .txt first, then open in Excel), I'm open to them!
Edit2: Following this answer, I tried creating a .txt file to do the same. It does work, as expected, but again, hangs up Word after about 4 pages. I've left it running for 10 minutes, and it isn't complete...
Edit3: I tried keeping this all within Word. I created a String Array, and when I found an underlined word, I just added that word to the array. However, this also gets to a point where it fails and just freezes.