迭代通过已发送邮件文件夹 - 打非邮件时出现错误项目

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 
    On Error Resume Next 
    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