Exporting Email Table Data from Outlook
Can somebody help me. This code works fine but I get Run Time Error 13 Type Mismatch error when loop comes to Meeting Request/Appointment/Task in outlook. The error comes at end of the loop i.e. Next OLMAIL. I am not able to trap it. On Error Resume Next is not working. I got another workaround If Not TypeName(OLMAIL) = “MailItem” Then MsgBox “not a mail item” but unsure where and how to put it in the code.
Secondly If OLMAIL.SentOn > CDate(“2024-4-30 23:17:00”) And Left(Trim(OLMAIL.Subject), 5) = “Recon” Then
If I switch on this condition how to skip Re and Fw emails in the code.
Sub ExtractTableDataFromOutlookEmails()
Range(“A1:x1500”).Clear
Dim OLApp As Outlook.Application
Set OLApp = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = OLApp.GetNamespace(“MAPI”)
Dim MYFOLDER As Outlook.Folder
Set MYFOLDER = ONS.Folders(“email address removed for privacy reasons”).Folders(“sent items”)
Dim OLMAIL As Outlook.MailItem
Set OLMAIL = OLApp.CreateItem(olMailItem)
For Each OLMAIL In MYFOLDER.Items
Dim oHTML As MSHTML.HTMLDocument
Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
Dim olmType As String
With oHTML
.body.innerHTML = OLMAIL.HTMLBody
Set oElColl = .getElementsByTagName(“table”)
End With
Dim t As Long, r As Long, c As Long
Dim eRow As Long
‘If OLMAIL.SentOn > CDate(“2024-4-30 23:17:00”) And Left(Trim(OLMAIL.Subject), 5) = “Recon” Then
For t = 0 To oElColl.Length – 1
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For r = 0 To (oElColl(t).Rows.Length – 1)
For c = 0 To (oElColl(t).Rows(r).Cells.Length – 1)
Range(“A” & eRow).Offset(r, c).Value = oElColl(t).Rows(r).Cells(c).innerText
Next c
Next r
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(eRow, 1) = “Senders Name: ” & ” ” & OLMAIL.Sender
Cells(eRow, 2) = “Date & Time of Sent: ” & ” ” & OLMAIL.SentOn
Cells(eRow, 3) = “Subject: ” & ” ” & OLMAIL.Subject
Next t
‘ End If
If Not TypeName(OLMAIL) = “MailItem” Then MsgBox “not a mail item”
Next OLMAIL
Range(“A1”).Select
Set OLApp = Nothing
Set OLMAIL = Nothing
Set oHTML = Nothing
Set oElColl = Nothing
‘ThisWorkbook.VBProject.VBE.MainWindow.Visible = False
End Sub
Can somebody help me. This code works fine but I get Run Time Error 13 Type Mismatch error when loop comes to Meeting Request/Appointment/Task in outlook. The error comes at end of the loop i.e. Next OLMAIL. I am not able to trap it. On Error Resume Next is not working. I got another workaround If Not TypeName(OLMAIL) = “MailItem” Then MsgBox “not a mail item” but unsure where and how to put it in the code.Secondly If OLMAIL.SentOn > CDate(“2024-4-30 23:17:00”) And Left(Trim(OLMAIL.Subject), 5) = “Recon” ThenIf I switch on this condition how to skip Re and Fw emails in the code. Sub ExtractTableDataFromOutlookEmails() Range(“A1:x1500”).ClearDim OLApp As Outlook.ApplicationSet OLApp = New Outlook.ApplicationDim ONS As Outlook.NamespaceSet ONS = OLApp.GetNamespace(“MAPI”)Dim MYFOLDER As Outlook.FolderSet MYFOLDER = ONS.Folders(“email address removed for privacy reasons”).Folders(“sent items”)Dim OLMAIL As Outlook.MailItemSet OLMAIL = OLApp.CreateItem(olMailItem)For Each OLMAIL In MYFOLDER.ItemsDim oHTML As MSHTML.HTMLDocumentSet oHTML = New MSHTML.HTMLDocumentDim oElColl As MSHTML.IHTMLElementCollectionDim olmType As StringWith oHTML.body.innerHTML = OLMAIL.HTMLBodySet oElColl = .getElementsByTagName(“table”)End WithDim t As Long, r As Long, c As LongDim eRow As Long’If OLMAIL.SentOn > CDate(“2024-4-30 23:17:00”) And Left(Trim(OLMAIL.Subject), 5) = “Recon” ThenFor t = 0 To oElColl.Length – 1 eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).RowFor r = 0 To (oElColl(t).Rows.Length – 1)For c = 0 To (oElColl(t).Rows(r).Cells.Length – 1)Range(“A” & eRow).Offset(r, c).Value = oElColl(t).Rows(r).Cells(c).innerTextNext cNext reRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).RowCells(eRow, 1) = “Senders Name: ” & ” ” & OLMAIL.SenderCells(eRow, 2) = “Date & Time of Sent: ” & ” ” & OLMAIL.SentOnCells(eRow, 3) = “Subject: ” & ” ” & OLMAIL.SubjectNext t’ End IfIf Not TypeName(OLMAIL) = “MailItem” Then MsgBox “not a mail item”Next OLMAILRange(“A1”).SelectSet OLApp = NothingSet OLMAIL = NothingSet oHTML = NothingSet oElColl = Nothing’ThisWorkbook.VBProject.VBE.MainWindow.Visible = FalseEnd Sub Read More