Extract first table of Outlook mail folder

[abhishukla15]

I'm trying to extract first table of each mail of a specific folder to Excel. If there is more than one table in the mail we can exclude it and move to next mail item. Below is the code I have at the moment. Could you please hel​

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">PublicSub Import_Tables_From_Outlook_Emails()
Dim oApp As Outlook.Application, oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem, HTMLdoc As MSHTML.HTMLDocument
Dim tables As MSHTML.IHTMLElementCollection, table As MSHTML.HTMLTable
Dim objExcelApp As Excel.Application, x AsLong, y AsLong, destCell As Range
Dim objExcelWorkbook As Excel.Workbook, objExcelWorksheet As Excel.Worksheet

Set objExcelApp = CreateObject("Excel.Application")'Create a new excel workbook
Set objExcelWorkbook = objExcelApp.Workbooks.Add
objExcelApp.Visible =True
Set destCell = ActiveSheet.Cells(Rows.Count,"A").End(xlUp)

OnErrorResumeNext
Set oApp = GetObject(,"OUTLOOK.APPLICATION")
If oApp IsNothingThenSet oApp = CreateObject("OUTLOOK.APPLICATION")
OnErrorGoTo0

Set oMapi = oApp.GetNamespace("MAPI").PickFolder
IfNot oMapi IsNothingThen
ForEach oMail In oMapi.items
'Get HTML tables from email object
Set HTMLdoc =New MSHTML.HTMLDocument
With HTMLdoc
.Body.innerHTML = oMail.HTMLBody
Set tables =.getElementsByTagName("table")
EndWith
ForEach table In tables
For x =0To table.Rows.Length -1
For y =0To table.Rows(x).Cells.Length -1
destCell.Offset(x, y).Value = _
table.Rows(x).Cells(y).innerText
Next y
Next x
Sheets.Add After:=ActiveSheet
Range("A1").Activate
Set destCell = ActiveSheet.Range("A1")
Next
Next
EndIf
Set oApp =Nothing
Set oMapi =Nothing
Set oMail =Nothing
Set HTMLdoc =Nothing
Set tables =Nothing
MsgBox "Finished"
EndSub</code>

 

[Domenic]

This question has also been posted in the following link...

https://stackoverflow.com/questions...-of-outlook-mail-folder/52246793?noredirect=1

 

[abhishukla15]

Yes, thanks. Got the answer.