Using VBA, print an array made in Word to Excel - arrays

Question

I am a VBA novice and I am trying to print an array that I was able to make (basically copying from another post) in VBA today. I placed a break into the script and inspected the array in the locals page to see that the array captures what I want (and some extra data that I will filter out). I spent the day reading about printing arrays on stack overflow and other sites and I ended up a bit lost. My goal is to export the array as a table in excel.
The script looks for underlined sentences in a 400 page word document and places them into the array. All that's really necessary for printing is the underlined sentences, so maybe an array wasn't the best approach? How can I export the array 'myWords' to a fresh excel document or one that I designate?
Many thanks for your help!
Sub addUnderlinedWordsToArray()
On Error GoTo errhand:
Dim myWords() As String
Dim i As Long
Dim myDoc As Document: Set myDoc = ActiveDocument ' Change as needed
Dim aRange As Range: Set aRange = myDoc.Content
Dim sRanges As StoryRanges: Set sRanges = myDoc.StoryRanges
Dim ArrayCounter As Long: ArrayCounter = 0 ' counter for items added to the array
Dim Sentence As Range
Dim w As Variant
Application.ScreenUpdating = False
ReDim myWords(aRange.Words.Count) ' set a array as large as the
' number of words in the doc
For Each Sentence In ActiveDocument.StoryRanges
For Each w In ActiveDocument.Sentences
If w.Font.Underline <> wdUnderlineNone Then
myWords(ArrayCounter) = w
ArrayCounter = ArrayCounter + 1
End If
Next
Next
Set myDoc = Nothing
Set aRange = Nothing
Set sRange = Nothing
Application.ScreenUpdating = True
Exit Sub
errhand:
Application.ScreenUpdating = True
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Subroutine Name: addUnderlinedWordsToArray" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
End Sub

Answer 1

I prefer to use Late Binding over adding an external reference to Excel. This will allow the code to work properly no mater what version of Office is installed.
Sub addUnderlinedWordsToArray()
On Error GoTo errhand:
Dim myWords() As String
Dim i As Long
Dim myDoc As Document: Set myDoc = ActiveDocument ' Change as needed
Dim aRange As Range: Set aRange = myDoc.Content
Dim sRanges As StoryRanges: Set sRanges = myDoc.StoryRanges
Dim ArrayCounter As Long: ArrayCounter = 0 ' counter for items added to the array
Dim Sentence As Range
Dim w As Variant
Application.ScreenUpdating = False
ReDim myWords(aRange.Words.Count) ' set a array as large as the
' number of words in the doc
For Each Sentence In ActiveDocument.StoryRanges
For Each w In ActiveDocument.Sentences
If w.Font.Underline <> wdUnderlineNone Then
myWords(ArrayCounter) = w
ArrayCounter = ArrayCounter + 1
End If
Next
Next
ReDim Preserve myWords(ArrayCounter - 1)
AddWordsToExcel myWords
Set myDoc = Nothing
Set aRange = Nothing
Set sRange = Nothing
Application.ScreenUpdating = True
Exit Sub
errhand:
Application.ScreenUpdating = True
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Subroutine Name: addUnderlinedWordsToArray" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
End Sub
Sub AddWordsToExcel(myWords() As String)
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim wb As Object
Set wb = xlApp.Workbooks.Add
wb.Worksheets(1).Range("A1").Resize(UBound(myWords) + 1).Value = xlApp.Transpose(myWords)
xlApp.Visible = True
End Sub

Answer 2

This is tested and working fine :
Option Explicit
Sub addUnderlinedWordsToArray()
Dim myWords() As String
Dim i As Long
Dim myDoc As Document: Set myDoc = ActiveDocument ' Change as needed
Dim aRange As Range: Set aRange = myDoc.Content
Dim sRanges As StoryRanges: Set sRanges = myDoc.StoryRanges
Dim ArrayCounter As Long: ArrayCounter = 0 ' counter for items added to the array
Dim Sentence As Range
Dim w As Variant
Dim Ex0 As Excel.Application
Dim Wb0 As Workbook
Application.ScreenUpdating = False
On Error GoTo errhand:
For Each Sentence In ActiveDocument.StoryRanges
For Each w In ActiveDocument.Sentences
If w.Font.Underline <> wdUnderlineNone Then
ReDim Preserve myWords(ArrayCounter)
myWords(ArrayCounter) = w
ArrayCounter = ArrayCounter + 1
End If
Next
Next
On Error GoTo 0
Set myDoc = Nothing
Set aRange = Nothing
Set sRanges = Nothing
Set Ex0 = New Excel.Application
Set Wb0 = Ex0.workbooks.Add
Ex0.Visible = True
Wb0.Sheets(1).Range("A1").Resize(UBound(myWords) + 1, 1) = WorksheetFunction.Transpose(myWords)
Application.ScreenUpdating = True
Debug.Print UBound(myWords())
Exit Sub
errhand:
Application.ScreenUpdating = True
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Subroutine Name: addUnderlinedWordsToArray" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
End Sub
Make sure to have the Microsoft Excel 14.0 Object Library ticked in Tools/References

Answer 3

The code provided in the question has some problems, which I've tried to correct as per the problem description.
The code declares a number of object variables, assigning them in the same line as the declaration, but these objects are never used. In order to improve code readability and make these objects "obvious" I've moved the instantiations to new lines.
The sample code below then substitutes these objects for the ActiveDocument... objects used in the original code, where these objects are intended to be used. This makes the code more readabile and more efficient.
The use of StoryRanges is questionable in the context of the code. StoryRanges are not the same as Sentences. On the assumption that the use of StoryRanges was a misunderstanding or typo, I've changed the code to use Sentences. If StoryRanges is meant, the code can loop through them, but certain structural changes would be required. (StoryRanges enables code to access all parts of a document such as TextBoxes, Headers, Footers, Endnotes - instead of just the main body of the document.)
It makes no sense to loop sentences while sizing the array to the number of words in the document. This has been changed to the number of sentences, which will require less memory.
Only the text, not the entire sentence Range should be added to the array since Excel can't do anything with a Word.Range except accept its text. This will require less memory.
On the assumption that not every sentence in the document is underlined, it's not necessary to maintain an array with empty members, so after the loop the array is resized to contain only those that have been populated. (ReDim Preserve myWords(ArrayCounter - 1)). This will avoid writing "empty" content to the Excel worksheet.
The code to write to Excel is in a separate procedure, making it re-usable for other arrays that might need to be transferred to Excel. The code has been written as late-binding, making it independent of requiring a reference to the Excel library. If early-binding (with a reference) is desired, those declarations are commented out in-line.
The writing to Excel only occurs if the array contains members. If ArrayCounter has never been incremented, the call to the other procedure is not performed.
The Excel objects are set to Nothing at the end of that procedure.
Note: The code posted in the question and used here picks up any sentence that contains an underline.
Sample code:
Sub addUnderlinedWordsToArray()
On Error GoTo errhand:
Dim myWords() As String
Dim i As Long
Dim myDoc As Document
Dim aRange As Range
Dim sRanges As Sentences
Dim ArrayCounter As Long ' counter for items added to the array
Dim Sentence As Range
Dim w As Variant
Application.ScreenUpdating = False
Set myDoc = ActiveDocument ' Change as needed
Set aRange = myDoc.content
Set sRanges = myDoc.Sentences
ArrayCounter = 0
ReDim myWords(aRange.Sentences.Count - 1) ' set a array as large as the
' number of sentences in the doc
For Each Sentence In sRanges
If Sentence.Font.Underline <> wdUnderlineNone Then
myWords(ArrayCounter) = Sentence.text
ArrayCounter = ArrayCounter + 1
End If
Next
If ArrayCounter > 0 Then
ReDim Preserve myWords(ArrayCounter - 1)
WriteToExcel myWords
End If
Set myDoc = Nothing
Set aRange = Nothing
Set sRanges = Nothing
Application.ScreenUpdating = True
Exit Sub
errhand:
Application.ScreenUpdating = True
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Subroutine Name: addUnderlinedWordsToArray" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
End Sub
Sub WriteToExcel(a As Variant)
Dim appExcel As Object 'Excel.Application
Dim wb As Object ' Excel.Workbook
Dim r As Object ' Excel.Range
Dim i As Long
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
appExcel.UserControl = True
Set wb = appExcel.Workbooks.Add
Set r = wb.Worksheets(1).Range("A1")
r.Resize(UBound(myWords) + 1).Value = xlApp.Transpose(myWords)
Set r = Nothing
Set wb = Nothing
Set appExcel = Nothing
End Sub

Answer 4

The general answer is to use Range ("A1") = myWords(ArrayCounter)
You would need to step through the array while simultaneously moving to the next cell.
You could also use Range ("A1:B3") = myWords.