'How to handle non-email when importing Outlook email data into Excel with VBA?

I'm trying to import all mails received and sent the past year.

For the received mails works, but the code stops when importing the sent mails. Specifically for the OutlookMail.To property. It stops when it gets to an accepted invitation for a meeting that I have sent.

Is there a way to bypass all the accepted invitations that I have sent and only get the emails?

Sub GetFromOutlook()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder1 As MAPIFolder
Dim Folder2 As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder1 = OutlookNamespace.GetDefaultFolder(olFolderInbox)
Set Folder2 = OutlookNamespace.GetDefaultFolder(olFolderSentMail)

i = 1

For Each OutlookMail In Folder1.Items
    If OutlookMail.ReceivedTime >= Range("H5").Value And OutlookMail.ReceivedTime <= Range("I5").Value Then
        Range("C4").Offset(i, 0).Value = OutlookMail.Subject
        Range("A4").Offset(i, 0).Value = OutlookMail.ReceivedTime
        Range("B4").Offset(i, 0).Value = OutlookMail.SenderName
        i = i + 1
    End If

j = 1

Next OutlookMail

For Each OutlookMail In Folder2.Items
    If OutlookMail.ReceivedTime >= Range("H5").Value And OutlookMail.ReceivedTime <= Range("I5").Value Then
        Range("f4").Offset(j, 0).Value = OutlookMail.Subject
        Range("d4").Offset(j, 0).Value = OutlookMail.ReceivedTime
        Range("E4").Offset(j, 0).Value = OutlookMail.To
        
        j = j + 1
    End If
Next OutlookMail

Set Folder1 = Nothing
Set Folder2 = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
    
End Sub


Solution 1:[1]

Something like this (refactoring a bit)

Sub GetFromOutlook()

    Dim olApp As Outlook.Application
    Dim olNS As Namespace, ws As Worksheet
    
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set ws = ActiveSheet
    
    ListFolder olNS.GetDefaultFolder(olFolderInbox), ws.Range("C4")
    ListFolder olNS.GetDefaultFolder(olFolderSentMail), ws.Range("F4")

End Sub

'List info for all mail items in `fldr`, starting at `rng`
Sub ListFolder(fldr As MAPIFolder, rng As Range)
    Dim itm As Variant, i As Long
    For Each itm In fldr.Items
        If TypeOf itm Is MailItem Then   'is this a mail item?
            'faster to write whole row in one shot
            rng.Cells(1).Offset(i).Resize(1, 3).Value = _
                Array(itm.Subject, itm.ReceivedTime, itm.to)
            i = i + 1 'increment row
        End If 'is a mail object
    Next itm
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Tim Williams