VBA Copy table from email to Excel - Cannot paste the data - 1004

Gertdj
Copper Contributor
Oct 12, 2021
Yea_So
Thank you for the suggestion - I will definitely investigate further.
I am grabbing a table from the body of an email though and then sending it to Excel for further manipulation - not sure if Power Query is the best tool for this... disclaimer - I haven't worked with Power Query much before...
- Yea_So
  Bronze Contributor
  Oct 12, 2021
  Gertdj
  
  I only suggested it because your code mentioned pdf, as pdf can only be an attachment unless it is an embedded object.
  
  Sub PDF_To_Excel()
  
  Dim setting_sh As Worksheet
  Set setting_sh = ThisWorkbook.Sheets("Setting")
  
  Dim pdf_path As String
  Dim excel_path As String
  
  pdf_path = setting_sh.Range("E11").Value
  excel_path = setting_sh.Range("E12").Value
  
  Dim fso As New FileSystemObject
  Dim fo As Folder
  Dim f As File
  Set fo = fso.GetFolder(pdf_path)
  Dim wa As Object
  Dim doc As Object
  Dim wr As Object
  Set wa = CreateObject("word.application")
  
  wa.Visible = True
  
  Dim nwb As Workbook
  Dim nsh As Worksheet
  For Each f In fo.Files
  Set doc = wa.documents.Open(f.Path, False, Format:="PDF Files")
  Set wr = doc.Paragraphs(1).Range
  wr.WholeStory
  
  Set nwb = Workbooks.Add
  Set nsh = nwb.Sheets(1)
  wr.Copy
  
  nsh.Paste
  nwb.SaveAs (excel_path & "\" & Replace(f.Name, ".pdf", ".xlsx"))
  
  'Clipboard 123
  doc.Close False
  nwb.Close False
  
  Next
  
  wa.Quit
  MsgBox "Done"
  
  End Sub
  - Gertdj
    Copper Contributor
    Oct 12, 2021
    Yea_So
    My humble apologies...
    I managed to insert incorrect code from another project I am busy with.
    Here is the correct Sub. It gives the error on the last line.
    
    Sub GetTable()
    
    Dim oLookInspector As Inspector
    Dim oLookMailitem As MailItem
    
    'Declare Word Variables.
    Dim oLookWordDoc As Word.Document
    Dim oLookWordTbl As Word.Table
    
    'Declare Excel Variables.
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlWrkSheet As Excel.Worksheet
    
    'Get mail item.
    Set oLookMailitem = Application.ActiveExplorer.CurrentFolder.Items("Test Table")
    
    'Get Active Inspector.
    Set oLookInspector = oLookMailitem.GetInspector
    
    'Get Word Editor object
    Set oLookWordDoc = oLookInspector.WordEditor
    
    'Create new Excel App.
    Set xlApp = New Excel.Application
    
    'Make visible.
    xlApp.Visible = True
    
    'Add new workbook.
    Set xlBook = xlApp.Workbooks.Add
    '
    ''Add a new worksheet.
    'Set xlWrkSheet = xlBook.Worksheets.Add
    Set xlWrkSheet = xlBook.Sheets(1)
    
    'Grab the Word Table.
    Set oLookWordTbl = oLookWordDoc.Tables(1)
    
    'Copy the table.
    oLookWordTbl.Range.Copy
    
    'Paste it to the sheet.
    xlWrkSheet.Paste Destination:=xlWrkSheet.Range("A1")
    
    End Sub

Forum Discussion

VBA Copy table from email to Excel - Cannot paste the data - 1004

Resources