CODEWITHSUNDEEP
arraysexcelvba
nick lanta
nick lanta

Reputation: 638

printing array only resulting in first value being printed into excel?

Assigning word document lines of text to an array to then print into an excel column. I want to print each item in array to it's own cell.

Currently, all the items are storying correctly into the array, but it's only printing the first item over and over Action

enter image description here

Code:

Option Explicit
Sub ParaCopy()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Set wApp = CreateObject("Word.Application")
    Set wDoc = wApp.Documents.Open("J:\Data Dictionary.docx", ReadOnly:=True)

    Dim wPara As Word.Paragraph
    Dim arr() As Variant
    Dim i As Long
    i = 0
    For Each wPara In wDoc.Paragraphs
        If wPara.Range.Words.Count > 1 Then
            ReDim Preserve arr(i)
            arr(i) = wPara.Range
        End If
        i = i + 1
    Next wPara
    For i = LBound(arr) To UBound(arr)
        [a1].Resize(UBound(arr) + 1) = arr
    Next i
    
End Sub

EDIT: Need to separate each block of text separated by a space (outlined in blue) to this word doc output in excel

Upvotes: 2

Views: 530

Answers (2)

Scott Craner
Scott Craner

Reputation: 152505

Create a 2D array with one column and load that:

Option Explicit
Sub ParaCopy()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Set wApp = CreateObject("Word.Application")
    Set wDoc = wApp.Documents.Open("J:\Data Dictionary.docx", ReadOnly:=True)

    Dim wPara As Word.Paragraph
    Dim arr() As Variant
    ReDim arr(1 To wDoc.Paragraphs.Count, 1 To 1)
    Dim i As Long
    i = 1
    For Each wPara In wDoc.Paragraphs
        If wPara.Range.Words.Count > 1 Then
            arr(i, 1) = wPara.Range
            i = i + 1
        End If
        
    Next wPara

    [a1].Resize(UBound(arr) + 1) = arr
    
End Sub

Upvotes: 3

VBasic2008
VBasic2008

Reputation: 54807

Copy Word Paragraphs to Excel Cells Using an Array

  • The number of rows of the array is wDoc.Paragraphs.Count which may differ from r (the 'actual count') hence you have to use r with Resize, and not wDoc.Paragraphs.Count or UBound(Data, 1).
  • Don't forget to Close the Document and Quit the App.
  • The first solution is early-bound and needs the library reference. When using it, just use
    Set wApp = New Word.Application.
  • The second solution is late-bound and doesn't need the library reference. Also, it has been 'stripped off' the document and application variables (not necessary, you can declare them As Object).
Option Explicit

' e.g. Tools>References>Microsoft Word 16.0 Object Library
Sub ParaCopy()
    
    Const FilePath As String = "J:\Data Dictionary.docx"
        
    Dim wApp As Word.Application: Set wApp = Set wApp = New Word.Application
    Dim wDoc As Word.Document: Set wDoc = wApp.Documents.Open(FilePath, , True)
    
    Dim Data As Variant: ReDim Data(1 To wDoc.Paragraphs.Count, 1 To 1)
    
    Dim wPara As Word.Paragraph
    Dim r As Long
    
    For Each wPara In wDoc.Paragraphs
        If wPara.Range.Words.Count > 1 Then
            r = r + 1
            Data(r, 1) = wPara.Range
        End If
    Next wPara
    
    wDoc.Close False
    wApp.Quit
    
    [a1].Resize(r) = Data
    
End Sub

Sub ParaCopyNoReference()
    
    Const FilePath As String = "J:\Data Dictionary.docx"
        
    With CreateObject("Word.Application")
        With .Documents.Open(FilePath, , True)
            Dim Data As Variant: ReDim Data(1 To .Paragraphs.Count, 1 To 1)
            Dim wPara As Object
            Dim r As Long
            For Each wPara In .Paragraphs
                If wPara.Range.Words.Count > 1 Then
                    r = r + 1
                    Data(r, 1) = wPara.Range
                End If
            Next wPara
            .Close False
        End With
        .Quit
    End With
    
    [a1].Resize(r) = Data
    
End Sub

Upvotes: 1

Related Questions