Copy Excel Table into existing Word Document stored on Sharepoint

[jessitarexcel]

I have spent days now searching for a solution to this problem and none of the solutions I have found work. I really need help with this macro. It should work, I have written so many iterations it is ridiculous and have watched a heap of Youtube videos as well. Any assistance is sincerely appreciated. I have made sure that Microsoft and Microsoft Word Objects 16.0 is selected in references.

The text in red isn't working. Is it the name of the tab that is the issue?

This is the latest instance of the VBA and I will post the other versions I have tried in comments below this post.

Dim wordObject As Object
Dim wordDocument As Object
Dim wordTable As Object

Application.ScreenUpdating = False
Application.EnableEvents = False

ThisWorkbook.Worksheet(COW and Stat Dec Table.Name).ListObjects("StatDecTable").Range

On Error Resume Next
Set WordApp = GetObject(class:="Word.Application")
If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

Set pageEditor = xInspect.WordEditor
WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed for Privacy" (The link does work and the right word document opens but it won't paste the table)

Stat Dec and COW Table - New.Range("StatDecTable"[#All]").Copy
mydoc.Paragraphs(1).Range.PasteExcelTable_
LinkedtoExcel = False, _
WordFormatting = False, _
RTF: = False

Application.ScreenUpdating = True
Application.EnableEvents = True
Set pageEditor = Nothing
'Clear the clipboard
Application.CutCopyMode = False

End Sub

 

[jessitarexcel]

I have made a new sheet and this is the code I just tested below. Once it gets to the ThisWorkbook.Worksheet section - I get a compile error which I have taken a screenshot of for reference. You can also see that I have replaced the link with the right link.

The other section that it gets caught on is the:

LinkedtoExcel = False, _
WordFormatting = False, _
RTF: = False

It keeps telling me that the expected expression is not correct and it seems to refer to the underscore.

Private Sub CopytoStatDec_Click()
Dim wordObject As Object
Dim wordDocument As Object
Dim wordTable As Object

Application.ScreenUpdating = False
Application.EnableEvents = False

ThisWorkbook.Worksheet(COW_Stat_Dec_Tables.Name).ListObjects("StatDecTable").Range

On Error Resume Next
Set WordApp = GetObject(class:="Word.Application")
If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

Set pageEditor = xInspect.WordEditor
WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed for Privacy"

COW_Stat_Dec_Tables.Range("StatDecTable").Copy
mydoc.Paragraphs(1).Range.PasteExcelTable_
LinkedtoExcel = False, _
WordFormatting = False, _
RTF: = False

Application.ScreenUpdating = True
Application.EnableEvents = True
Set pageEditor = Nothing
'Clear the clipboard
Application.CutCopyMode = False

End Sub

 

[NdNoviceHlp]

I think there's something buggy with your wb. Take a few minutes for a test. On your "C" drive add a folder and name it "TestFolder". Open the TestFolder and add a new Word .docx file and name it "Test". Start a new workbook. Change the sheet name to "Stat Dec and Cow Table". Add a table to this sheet and then rename it "StatDecTable". Copy and paste this code and run it..

Sub TableTest()
Dim WordApp As Object, WordDoc As Object
Dim tbl As Range, objdoc As Object, WordTbl As Object
'create Word app
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WordApp.Visible = True
 
Set objdoc = WordApp.Documents.Open("C:\Testfolder\testdoc.docx")
Set tbl = ThisWorkbook.Worksheets("Stat Dec and COW Table") _
                                 .ListObjects("StatDecTable").Range
tbl.Copy
objdoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
Application.CutCopyMode = False
With objdoc
Set WordTbl = .Tables(1)
With WordTbl
.AutoFitBehavior (2)
End With
End With
End Sub

It's fairly straight forward and should not be so difficult. Dave

 

[NdNoviceHlp]

Seems like a new test could be useful. Dave

Sub test()
Dim sht As Worksheet, sh As Worksheet, tbl As ListObject
For Each sht In ThisWorkbook.Sheets
Set sh = ThisWorkbook.Sheets(sht.Name)
For Each tbl In sh.ListObjects
MsgBox "Sheet Name: " & sht.Name & "   Table Name: " & tbl.Name
Next tbl
Next sht
End Sub

 

[jessitarexcel]

Seems like a new test could be useful. Dave

Sub test()
Dim sht As Worksheet, sh As Worksheet, tbl As ListObject
For Each sht In ThisWorkbook.Sheets
Set sh = ThisWorkbook.Sheets(sht.Name)
For Each tbl In sh.ListObjects
MsgBox "Sheet Name: " & sht.Name & "   Table Name: " & tbl.Name
Next tbl
Next sht
End Sub

Good morning Dave, I am back at it again this morning. Let me try both of these tests. I do have a new template now that is clean but I agree, something buggy is going on. I am using my own office subscription but going to login to the client one to see if that makes any difference at all. Thank you for all of your help on this. I agree, there is no way this should be so difficult.

 

[jessitarexcel]

I think there's something buggy with your wb. Take a few minutes for a test. On your "C" drive add a folder and name it "TestFolder". Open the TestFolder and add a new Word .docx file and name it "Test". Start a new workbook. Change the sheet name to "Stat Dec and Cow Table". Add a table to this sheet and then rename it "StatDecTable". Copy and paste this code and run it..

Sub TableTest()
Dim WordApp As Object, WordDoc As Object
Dim tbl As Range, objdoc As Object, WordTbl As Object
'create Word app
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0
WordApp.Visible = True
 
Set objdoc = WordApp.Documents.Open("C:\Testfolder\testdoc.docx")
Set tbl = ThisWorkbook.Worksheets("Stat Dec and COW Table") _
                                 .ListObjects("StatDecTable").Range
tbl.Copy
objdoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
Application.CutCopyMode = False
With objdoc
Set WordTbl = .Tables(1)
With WordTbl
.AutoFitBehavior (2)
End With
End With
End Sub

It's fairly straight forward and should not be so difficult. Dave

Hi Dave, I gave this one a test and followed your instructions and it did work this time. I will now try the next test.

 

[jessitarexcel]

Seems like a new test could be useful. Dave

Sub test()
Dim sht As Worksheet, sh As Worksheet, tbl As ListObject
For Each sht In ThisWorkbook.Sheets
Set sh = ThisWorkbook.Sheets(sht.Name)
For Each tbl In sh.ListObjects
MsgBox "Sheet Name: " & sht.Name & "   Table Name: " & tbl.Name
Next tbl
Next sht
End Sub

I have now tried this test and this is the message box that comes up. This macro is working without any issues. I also wonder if it might be the word doc template as well? I might make another clean version of that as well. The staff here tend to muck around with the sheets and there is some odd legacy stuff in the document formatting. Might be better to start with a totally new document.