Question

我使用以下VBA代码检查具有特定主题标题的任何电子邮件。

问题是当我需要检查我的其他电子邮件帐户的收件箱时，它会检查我的默认Outlook收件箱文件夹。

有人可以告诉我我会怎么做吗？

Sub Macro1()
   Set olApp = CreateObject("Outlook.Application")

       Dim olNs As Outlook.Namespace
       Dim Fldr As Outlook.MAPIFolder
       Dim myItem As Outlook.MailItem
       Dim myAttachment As Outlook.Attachment
       Dim I As Long
       Dim olMail As Variant


       Set olApp = New Outlook.Application
       Set olNs = olApp.GetNamespace("MAPI")
       Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
       Set myTasks = Fldr.Items


    Set olMail = myTasks.Find("[Subject] = ""New Supplier Request: Ticket""")
    If Not (olMail Is Nothing) Then



      For Each myItem In myTasks
          If myItem.Attachments.Count <> 0 Then
              For Each myAttachment In myItem.Attachments
              If InStr(myAttachment.DisplayName, ".txt") Then
                  I = I + 1
                  myAttachment.SaveAsFile "\\uksh000-file06\Purchasing\NS\Unactioned\" & myAttachment
                  End If
              Next
          End If

      Next



  For Each myItem In myTasks
  myItem.Delete
  Next

  Call Macro2

  Else
  MsgBox "There Are No New Supplier Requests."
  End If
End Sub

Answer 1

原因是您已将变量myItem声明为Outlook.MailItem，稍后使用它来遍历MAPI文件夹中的项目集合。

但是，MAPI文件夹不仅包含MailItems，还包含MeetingItems，并且每次循环找到MeetingItem类型的对象时，都会抛出Mismatch类型错误，因为它只需要MailItem类型的对象。

您只需将myItem变量的声明更改为：

Dim myItem as Object

=============================================== ==============

以下代码应仅迭代已过滤的项目：

Sub Work_with_Outlook()
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim myItem As Object
    Dim myAttachment As Outlook.Attachment
    Dim olMail As Variant
    Dim i As Long



    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items



    Set olMail = myTasks.Find("[Subject] = ""test""")
    While Not olMail Is Nothing

        If olMail.Attachments.Count Then

            For Each myAttachment In olMail.Attachments
                i = i + 1
                myAttachment.SaveAsFile "\\uksh000-file06\Purchasing\Supplier Attachments\test" & i & ".txt"
            Next myAttachment

        End If

        Set olMail = myTasks.FindNext

    Wend

    MsgBox "Scan Complete."

End Sub

Answer 2

而不是遍历Outlook中的所有文件夹项目：

 For Each myItem In myTasks
    If myItem.Attachments.Count <> 0 Then
        For Each myAttachment In myItem.Attachments

我建议使用Items类的Find / FindNext或Restrict方法。您也可以考虑使用Application类的AdvancedSearch方法。请查看以下文章中的示例代码，说明如何在代码中使用它们：

VBA：在非默认Outlook收件箱中搜索电子邮件？

2 个答案: