Forum Discussion

CopyCatCoder's avatar
CopyCatCoder
Copper Contributor
May 02, 2024
Solved

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

  • CopyCatCoder 

    To address the issues you mentioned:

    1. 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.
    2. 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

  • NikolinoDE's avatar
    NikolinoDE
    Gold Contributor

    CopyCatCoder 

    To address the issues you mentioned:

    1. 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.
    2. 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.

Resources