Copying & Pasting information from Microsoft Word OLEObject to Excel file via VBA

Question

My issue is after I have imported a table from Microsoft Word into Excel by creating an OLEObject, it won't let me copy and paste the table into excel. It continually keeps pasting whatever was last copied on my clipboard into the first cell. Currently my code asks the user for the file name, opens that file as an OLEObject in the active excel sheet, and then pastes the incorrect information into cell A1. It's not copying and pasting what's inside the Word OLEObject.

 Sub Macro1()
    Dim FName As String, FD As FileDialog
    Dim ExR As Range
    Set FD = Application.FileDialog(msoFileDialogOpen)
    FD.Show
    If FD.SelectedItems.Count <> 0 Then
        FName = FD.SelectedItems(1)
    Else
        Exit Sub
    End If

    ActiveSheet.OLEObjects.Add(fileName:=FName, Link:=False, DisplayAsIcon:=False).Select
    Selection.Verb Verb:=xlPrimary
    Range("A1").Select
    ActiveSheet.Paste

End Sub

Thank you!

Answer 1

From Word to Excel, should be something like this.

Sub ImportFromWord()

'Activate Word Object Library

'Dim WordApp As Word.Application    
Dim WordDoc As Word.Document

Set WordApp = CreateObject("word.application") ' Open Word session

WordApp.Visible = False 'keep word invisible
Set WordDoc = WordApp.Documents.Open("C:\Users\your_path_here_\WordFile.docx") ' open Word file

'copy third row of first Word table
WordDoc.Tables(1).Rows(3).Range.Copy

'paste in Excel
Range("A1").PasteSpecial xlPasteValues

WordDoc.Close 'close Word doc
WordApp.Quit ' close Word

End Sub

Or this.

Sub GetTables() 

FName = Application _ 
.GetOpenFilename("Word Files (*.doc), *.doc") 

Set WordObject = GetObject(FName) 

First = True 
RowCount = 2 
For Each Tble In WordObject.tables 
For i = 1 To 22 
If First = True Then 
Data = Tble.Rows(i).Cells(1).Range 
'Remove cell markers 
Cells(1, i) = Left(Data, Len(Data) - 2) 
End If 
Data = Tble.Rows(i).Cells(2).Range.Text 
'Remove cell markers 
Cells(RowCount, i) = Left(Data, Len(Data) - 2) 
Next i 
RowCount = RowCount + 1 
First = False 
Next Tble 
WordObject.Close savechanges = False 
End Sub

Answer 2

Using the code from the link How to preserve source formatting while copying data from word table to excel sheet using VB macro? , I've only been able to get the code to work when the macro pastes my Word table in a whole new separate workbook. When clicking a command button that's within the excel workbook that I want to import the Word table to, the table never pastes into the sheet called "Scraping Sheets" I've messed around with the code, but the closest thing I could get was placing the entire table into one cell with all formatting lost.

Private Sub CommandButton22_Click()
Dim oWordApp As Object, oWordDoc As Object
Dim FlName As String
Dim tbl As Object

FlName = Application.GetOpenFilename("Word files (*.Doc*),*.Doc*", , _

On Error Resume Next
Set oWordApp = GetObject(, "Word.Applicaton")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True


Set oWordDoc = oWordApp.Documents.Open(FlName)

Set tbl = oWordDoc.Tables(1)

Dim wb As Workbook, ws As Worksheet

Set wb = Workbooks.Open(""C:\Users\xxxx\Desktop\292 Int'l_Weekly_Win_Loss_YYYY MM DD TEMPLATE.xlsm"")

Set ws = wb.Sheets("Scraping Sheet")

tbl.Range.Copy

ws.Range("A1").Activate

ws.Paste

MsgBox "Successfully Added File!"
End Sub