I am trying to export data from Excel to a pre-existing Word table.
Once the code reaches the For Each wdCell In wdDoc.Tables
loop I receive a run-time error
'91' Object variable or With with block variable not set appears.
Is there a way I can get this code to transfer data into 7 columns?
Sub ExportDataWordTable()
Const stWordDocument As String = "C:\Users\jfournier\Desktop\VBA Macro Files\TESTQUOTE.docm"
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Dim i As Long
Dim j As Long
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim vaData As Variant
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet2")
ReDim vaData(1 To 10, 1 To 5)
With wsSheet
vaData = .Range("B3:H20")
End With
'Here we instantiate the new object.
Set wdApp = New Word.Application
'Here the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
'Import data to the first table and in the first column of a table in Microsoft Word.
For j = 1 To 5
i = 0
For Each wdCell In wdDoc.Tables(2).Columns(j).Cells
i = i + 1
wdCell.Range.Text = vaData(i, j)
Next wdCell
Next j
'Save and close the document.
With wdDoc
.Save
.Close
End With
'Close the hidden instance of Microsoft Word.
wdApp.Quit
'Release the external variables from the memory
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "The data has been transferred to Test.doc", vbInformation
End Sub
Here's a different approach for you to try:
Sub ExportDataWordTable()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Const stWordDocument As String = "\TESTQUOTE.docm"
Dim xlWkBk As Workbook, xlWkSht As Worksheet
Set xlWkBk = ThisWorkbook: Set xlWkSht = xlWkBk.Worksheets("Sheet2")
'Here the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(Filename:=xlWkBk.Path & stWordDocument, AddToRecentFiles:=False)
'Copy the used range
With xlWkSht
.Range("B3:H" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy
End With
With wdDoc
'Paste the copied content to the end of the table
.Tables(2).Range.Characters.Last.PasteAppendTable
'Save and close the document.
.Close True
End With
'Close our instance of Microsoft Word.
wdApp.Quit
'Clear the clipboard
Application.CutCopyMode = False
'Release the external variables from the memory
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing: Set xlWkBk = Nothing
MsgBox "The data has been transferred to Test.doc", vbInformation
End Sub
Note: Since you have varying numbers of rows to copy, the code above assumes the usedrange determines the number of rows to be copied. With this approach, your Word table need only have its header row(s).
I have observed following points in your code for correction.
You are setting the full path of your your file TESTQUOTE.docm
Const stWordDocument As String = "C:\Users\jfournier\Desktop\VBA Macro Files\TESTQUOTE.docm"
Later on You are setting path that the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
This will give conflict in path string. You should mention only.
Const stWordDocument As String = "TESTQUOTE.docm"
You want code to transfer data into 7 columns. You have taken range as B3:H20
But you have set variant vaData
to 5 columns only.
ReDim vaData(1 To 10, 1 To 5)
Also you are looping for 5 columns only.
'Import data to the first table and in the first column of a table in Microsoft Word.
For j = 1 To 5
Thse two lines need to be changed to :-
ReDim vaData(1 To 10, 1 To 7)
For j = 1 To 7
Other points to ensure are:-
Finally your corrected code as follows.
Sub ExportDataWordTable()
Const stWordDocument As String = "TESTQUOTE.docm"
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell
Dim i As Long
Dim j As Long
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim vaData As Variant
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Sheet2")
ReDim vaData(1 To 10, 1 To 7)
With wsSheet
vaData = .Range("B3:H20")
End With
'Here we instantiate the new object.
Set wdApp = New Word.Application
'Here the target document resides in the same folder as the workbook.
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordDocument)
'Import data to the first table and in the first column of a table in Microsoft Word.
For j = 1 To 7
i = 0
For Each wdCell In wdDoc.Tables(1).Columns(j).Cells
i = i + 1
wdCell.Range.Text = vaData(i, j)
Next wdCell
Next j
'Save and close the document.
With wdDoc
.Save
.Close
End With
'Close the hidden instance of Microsoft Word.
wdApp.Quit
'Release the external variables from the memory
Set wdDoc = Nothing
Set wdApp = Nothing
MsgBox "The data has been transferred to TESTQUOTE.docm", vbInformation
End Sub
I have tested this program on sample data and I am appending the snapshot of Excel sample data and results obtained on Word document.
[SOLVED]
Err 4605 – "This method or property is not available because the clipboard is empty or not valid"
ErrResume:
DoEvents
Range("B3:H99").Copy
On Error GoTo ErrPaste
wdDoc.Tables(2).Range.Characters.Last.PasteAppendTable
Application.CutCopyMode = False
On Error GoTo 0
ErrPaste:
'Clipboard is empty or not valid.
If Err.Number = 4605 Then
DoEvents
Resume ErrResume
End If
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.