Hello All:
Code
Sub getTableDataFromOutlook()
'Declare our Variables
Dim oLookInspector As Inspector
Dim oLookMailItem As MailItem
'Declare our Variables
Dim oLookWordDoc As Word.Document
Dim oLookWordTbl As Word.Table
'Declare our Excel Variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
'Grab the mail item
Set oLookMailItem = Application.ActiveExplorer.CurrentFolder.Items("Auto-Stop Workflow Alert")
'Grab the active inspector
Set oLookInspector = oLookMailItem.GetInspector
'Grab the Word Editor Objec, this returns the Word Object Model.
Set oLookWordDoc = oLookInspector.WordEditor
'Create a new Excel Application
'Set xlApp = New Excel.Application
'Grab the Active instance
Set xlApp = GetObject(, "Excel.Application")
'Make the Excel Application Visible
xlApp.Visible = True
'Add a new workbook
Set xlBook = xlApp.Workbooks.Add
'Add a new worksheet
Set xlWrkSheet = xlBook.Worksheets.Add
'Grab the Word Table
Set oLookWordTbl = oLookWordDoc.Tables(1)
'copy the Table
oLookWordTbl.Range.Copy
'Paste it to the worksheet
xlWrkSheet.Paste Destination:=xlWrkSheet.Cells(1, 1)
End SubHello All:
From an Internet search, I found the attached code for extracting Table Data from a single Outlook email, which works very well. I have not figured out how to loop through a series of emails containing the same table format and load all data for all tables to a single Excel worksheet. Once I have loaded all the history, I want to execute the VBA script daily to pick up new incoming table data to update the Excel file.
If anyone can provide hints how to convert my single use VBA code to looping code, including the "xlUp function" to append data to the bottom of the last updated worksheet, I would be more that appreciative.
Many thanks in advance.