Forum Discussion
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
To address the issues you mentioned:
- To avoid the "Type Mismatch" error when encountering items other than mail items in the Outlook folder, you can use a conditional statement to check if the item is a MailItem before proceeding with the processing. You can place this check inside your loop before processing each item.
- To skip emails with subjects starting with "Re" or "Fw", you can add an additional condition within your loop to check if the subject of the email does not start with "Re" or "Fw".
Here is your modified code with these adjustments:
Vba code is untested; please backup your file before you use 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 Object ' Use Object type to handle different item types Dim oHTML As MSHTML.HTMLDocument Set oHTML = New MSHTML.HTMLDocument Dim oElColl As MSHTML.IHTMLElementCollection Dim t As Long, r As Long, c As Long Dim eRow As Long For Each OLMAIL In MYFOLDER.Items If TypeName(OLMAIL) = "MailItem" Then ' Check if the item is a MailItem If OLMAIL.SentOn > CDate("2024-4-30 23:17:00") And Left(Trim(OLMAIL.Subject), 5) = "Recon" Then With oHTML .Body.innerHTML = OLMAIL.HTMLBody Set oElColl = .getElementsByTagName("table") End With 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) = "Sender's Name: " & " " & OLMAIL.Sender Cells(eRow, 2) = "Date & Time of Sent: " & " " & OLMAIL.SentOn Cells(eRow, 3) = "Subject: " & " " & OLMAIL.Subject Next t End If End If Next OLMAIL Range("A1").Select Set OLApp = Nothing Set OLMAIL = Nothing Set oHTML = Nothing Set oElColl = Nothing End Sub
This code should address both the "Type Mismatch" error and the condition to skip emails with subjects starting with "Re" or "Fw". The text, steps and code were created with the help of AI.
My answers are voluntary and without guarantee!
Hope this will help you.
Was the answer useful? Mark as best response and Like it!
This will help all forum participants.
1 Reply
- NikolinoDEGold Contributor
To address the issues you mentioned:
- To avoid the "Type Mismatch" error when encountering items other than mail items in the Outlook folder, you can use a conditional statement to check if the item is a MailItem before proceeding with the processing. You can place this check inside your loop before processing each item.
- To skip emails with subjects starting with "Re" or "Fw", you can add an additional condition within your loop to check if the subject of the email does not start with "Re" or "Fw".
Here is your modified code with these adjustments:
Vba code is untested; please backup your file before you use 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 Object ' Use Object type to handle different item types Dim oHTML As MSHTML.HTMLDocument Set oHTML = New MSHTML.HTMLDocument Dim oElColl As MSHTML.IHTMLElementCollection Dim t As Long, r As Long, c As Long Dim eRow As Long For Each OLMAIL In MYFOLDER.Items If TypeName(OLMAIL) = "MailItem" Then ' Check if the item is a MailItem If OLMAIL.SentOn > CDate("2024-4-30 23:17:00") And Left(Trim(OLMAIL.Subject), 5) = "Recon" Then With oHTML .Body.innerHTML = OLMAIL.HTMLBody Set oElColl = .getElementsByTagName("table") End With 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) = "Sender's Name: " & " " & OLMAIL.Sender Cells(eRow, 2) = "Date & Time of Sent: " & " " & OLMAIL.SentOn Cells(eRow, 3) = "Subject: " & " " & OLMAIL.Subject Next t End If End If Next OLMAIL Range("A1").Select Set OLApp = Nothing Set OLMAIL = Nothing Set oHTML = Nothing Set oElColl = Nothing End Sub
This code should address both the "Type Mismatch" error and the condition to skip emails with subjects starting with "Re" or "Fw". The text, steps and code were created with the help of AI.
My answers are voluntary and without guarantee!
Hope this will help you.
Was the answer useful? Mark as best response and Like it!
This will help all forum participants.