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