vba - 遍历已发送邮件文件夹-点击非邮件项目时出错

Question

我正在尝试遍历“已发送邮件”文件夹中的所有邮件消息。

代码在遇到非邮件项(例如日历邀请)之前可以正常工作。

有没有办法跳过已发送项目文件夹中的日历项目？

Sub Find_Sent_Messages_With_Subject()

    Dim myOlapp As Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myItem As Outlook.MailItem


    Set myOlapp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlapp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)


    For Each myItem In myFolder.Items

        If InStr(1, myItem.Subject, "xxxxxxxxxxxxxx") > 0 Then
            'Stop
        End If

    Next myItem

End Sub

Answer 1

替换

For Each myItem In myFolder.Items

与

For i = myFolder.Items.Count To 1 Step -1 '<- backwards        
    Set myItem = myFolder.Items(i)
    Debug.Print myItem
Next i

或者尝试在循环时添加object.class

    If myItem.Class = olMail Then

例子:

Dim myItem As Object

For Each myItem In myFolder.Items
    If myItem.Class = olMail Then
        Debug.Print myItem
    End If
Next myItem

编辑

经过测试的 2010 年展望

Option Explicit
Sub Find_Sent_Messages_With_Subject()
    Dim myOlapp As Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.MAPIFolder
    Dim myItem As Object

    Set myOlapp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlapp.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderSentMail)

    For Each myItem In myFolder.Items
        If myItem.Class = olMail Then
            If InStr(1, myItem.Subject, "hello") > 0 Then
                Debug.Print myItem
            End If
        End If
    Next myItem

End Sub