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 Sub
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.