VBA outputting Outlook table to worksheet

Trebor8484

Board Regular
Joined
Oct 27, 2018
Messages
69
Office Version
  1. 2013
Platform
  1. Windows
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

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
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
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,309
Members
448,564
Latest member
ED38

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
Back
Top