VBA outputting Outlook table to worksheet

Trebor8484

Board Regular
Joined
Oct 27, 2018
Messages
57
Hi,

Can anyone help me adapt the code below please.

I am trying to amend it so that if sender email address is detected in my Inbox then the contents of the table from the email body are copied to a worksheet.

This partly works but I need it to copy to the next unused row each time another email from the specific sender is located in my inbox. Also if possible I need the header row to be omitted when copying the table into the worksheet.

VBA Code:
Private Sub Copy_Tbl()

    Dim Inbox As Outlook.MAPIFolder
    Dim DeletedFolder As Outlook.MAPIFolder
    Dim olNS As Outlook.Namespace
    Dim Item As MailItem
    Dim Items As Outlook.Items
    Dim lngCount As Long
    Dim oHTML As MSHTML.HTMLDocument
    Dim oElColl As MSHTML.IHTMLElementCollection
    Dim x As Long
    Dim y As Long
   
    Set olNS = Outlook.GetNamespace("MAPI")
    Set Inbox = olNS.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
    Set DeletedFolder = olNS.GetDefaultFolder(olFolderDeletedItems)
    Set oHTML = New MSHTML.HTMLDocument
        
    Application.ScreenUpdating = False

    For Each Item In Items
        If Item.Class = olMail Then
            'Debug.Print Item.Sender
            
            If Item.Sender = "me@emample.com" Then
                'Debug.Print Item.SentOn
            
                With oHTML
                    .Body.innerHTML = Item.HTMLBody
                    Set oElColl = .getElementsByTagName("table")
                End With
                
                For x = 0 To oElColl(0).Rows.Length - 1
                    For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
                        Range("A1").Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
                    Next y
                Next x
                
                Item.Move DeletedFolder
                
            End If
        End If
    Next Item
        
    Application.ScreenUpdating = True

End Sub


Thanks
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
2,148
After your macro add this Funcion:
VBA Code:
Function getLast() As Long
Dim LastR As Long
On Error Resume Next
LastR = Cells.Find(What:="*", After:=[A1], _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
On Error GoTo 0
getLast = LastR
End Function

Then let's modify your code...

A) Add the following line in the following position:
Code:
            If Item.Sender = "me@emample.com" Then
                'Debug.Print Item.SentOn
                StRan = "A" & getLast +1          '++++ ADD THIS LINE       
                With oHTML


B) After, instead of Range("A1").Offset(x, y).Value = etc etc use
Code:
Range(StRan).Offset(x, y).Value = etc etc


If you want to skip the header, then I assume that instead of For x = 0 To oElColl(0).Rows.Length - 1 you have to use
Code:
For x = 1 To oElColl(0).Rows.Length - 1

Bye
 

Forum statistics

Threads
1,136,868
Messages
5,678,224
Members
419,753
Latest member
Vj3006

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top