VBA Extract HTML Table

Sub demo()


Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
Dim oHTML As MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
Dim destCell As Range
    Dim x As Long, y As Long

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("folder1").Folders("folder2").Folders("folder3").Folders("folder4")
Set oMail = oMapi.Items(oMapi.Items.Count)



For Each oMail In oMapi.Items
    Set oHTML = New MSHTML.HTMLDocument
    With oHTML
        .Body.innerHTML = oMail.HTMLBody
        Set oElColl = .getElementsByTagName("table")
    End With


    For Each table In oElColl
        For x = 0 To oElColl(0).Rows.Length - 1
            For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
                If y = 1 Then
                    ActiveCell.Offset(y, x).Value = oElColl(0).Rows(x).Cells(y).innerText
                End If
            Next y
        Next x

    Next
Next


Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
End Sub