Extracting Table from outlook mail

[hearthhrob4gals]

Hi,

I have a code wherein it extracts details from emails from an inbox along with the mail body.

The code works perfectly fine. However, i added new lines of code for retaining the html format of the tables inside the mail body. However, its not picking up anything.

Any help on this would be highly appreciated

Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String

Const num As Integer = 6
Const path As String = "C:\Users\u248087\Desktop\JE\"
Const emailpath As String = "C:\Users\u248087\Desktop\JE\"
Const olFolderInbox As Integer = 6

Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
Set olmail = olmail.Folders("IMP")

If olmail.items.restrict("[UNREAD]=True").Count = 0 Then
MsgBox ("No Unread mails")

    Else

        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

            Range("A" & lrow).Value = olitem.Subject
            Range("B" & lrow).Value = olitem.senderemailaddress
            Range("C" & lrow).Value = olitem.To
            Range("D" & lrow).Value = olitem.cc
'            Range("E" & lrow).Value = olitem.Body
            Range("F" & lrow).Value = olitem.ReceivedTime

Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
    .Body.innerHTML = olitem.HTMLBody
    Set oElColl = .getElementsByTagName("table")
End With

'import in Excel
Dim x As Long, y As Long

For x = 0 To oElColl(0).Rows.Length - 1
    For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
        Range("E1").Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
    Next y
Next x


End If
ActiveSheet.Rows.WrapText = False

End Sub

 

[Norie]

Have you checked if oElColl is being populated?