Hi everyone,
We receive multiple emails from the same source during the day. They all contain a table in the same format. I would like to import the tables in the emails, starting from a specific day (e.g yesterday's date at a specific time).
I found the code below that imports the table from outlook to excel, but only from the latest email. Could you please show me how to make it copy the tables in the next emails starting from the specific date? Hopefully this makes sense.
Thank you!
We receive multiple emails from the same source during the day. They all contain a table in the same format. I would like to import the tables in the emails, starting from a specific day (e.g yesterday's date at a specific time).
I found the code below that imports the table from outlook to excel, but only from the latest email. Could you please show me how to make it copy the tables in the next emails starting from the specific date? Hopefully this makes sense.
VBA Code:
Option Explicit
Sub impOutlookTable()
' point to the desired email
Const strMail As String = "someone@somewhere.com"
Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
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").GetDefaultFolder(olFolderInbox).Folders("Oliver")
Set oMail = oMapi.Items(oMapi.Items.Count)
' get html table from email object
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
.Body.innerHTML = oMail.HTMLBody
Set oElColl = .getElementsByTagName("table")
End With
'import in Excel
Dim x As Long, y As Long
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Format(Date, "DD-MM-YY")
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
Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
End Sub
Thank you!