Copy Outlook Email HTML Body as Table to Excel

[E1375]

Hello !!!

I found this Sub here in MrExcel....

Sub OLook_to_Excel()
Dim oApp As Outlook.Application, oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection, x&, y&

On Error Resume Next
Set oApp = GetObject(, "OUTLOOK.APPLICATION")
If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")
On Error GoTo 0

Set oMapi = oApp.GetNamespace("MAPI").Folders(1).Folders(1) ' desired folder
Set oMail = oMapi.Items(oMapi.Items.Count) ' desired email

With oHTML
.Body.innerHTML = oMail.htmlBody
Set oElColl = .getElementsByTagName("table")
End With

For x = 0 To oElColl(0).Rows.Length - 1 ' import
For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
[A1].Offset(x, y) = oElColl(0).Rows(x).Cells.innerText
Next
Next
Set oApp = Nothing: Set oMapi = Nothing
Set oMail = Nothing: Set oHTML = Nothing
Set oElColl = Nothing
End Sub

Trying to use it.... I am getting error "Array index is out of bounds" when execution reaches:

Set oMail = oMapi.Items(oMapi.Items.Count) ' desired email

The value of oMail.Items.Count is zero. I do have unread emails in my inbox. In fact the email I am trying to process is the latest received and unread.

Could you please provide your valuable advise?

Thank you very much

e1375

 

[Domenic]

After the line that gets the desired folder, temporarily add the following line to see whether or not it in fact is pointing to the desired folder...

MsgBox oApp.GetNamespace("MAPI").Folders(1).Folders(1).Name

Does it point to the desired folder?

 

[E1375]

Thank you for your prompt response. The answer is no. It is pointing to the "Deleted Items" folder instead of the "Inbox" folder. I understand now why the error is being caused. How to make it point to the "Inbox" folder?

Thank you

e1375

 

[Domenic]

Is it your default folder? If so, try the following instead...

Set oMapi = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

Hope this helps!

 

[E1375]

Thank you. It does, the error is gone. Now the Sub is actually reading the desired eMail. There is a new problem with the remaining code of this sub since it does copy the entire eMail body into Sheet1 cell A1, instead of copying the Excel table contained in the read email to Sheet1. What I am trying to do is copy a table from an incoming email to a worksheet. Do you know if there is a piece of code that does this? I have read that the body of an email can be read with VBA as a String, as HTML and as RTF. What I am trying to do is retrieve the table from the eMail to Sheet1, with its data but also all the formatting. Please advise.

e1375

 

[Domenic]

First set the following reference (Visual Basic Editor >> Tools >> References) . . .

Microsoft Forms Object Library...

Then try something like this...

    'Your code here'  
    '
    '
   
    Dim oDataObject As MSForms.DataObject
    Set oDataObject = New MSForms.DataObject
   
    oDataObject.SetText oElColl(0).outerHTML
    oDataObject.PutInClipboard
   
    ActiveSheet.Paste Range("A1")

Hope this helps!

 

[E1375]

Hi !!!

I just started doing testing. It seems like your code above can do what I need. I need to do more testing. Will come back today or tomorrow at the latest, to provide more information.

In the meantime, thank you.

e1375