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

我正在使用下面的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

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

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

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

• 如何：使用Restrict方法从文件夹中检索Outlook邮件项目
• 如何：使用Find和FindNext方法从文件夹（C＃，VB.NET）检索Outlook邮件项目
• 在Outlook中以编程方式进行高级search：C＃，VB.NET

Answer 2

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

但是，MAPI文件夹不仅包含MailItems，还包含MeetingItems，并且每当循环findMeetingItemtypes的对象时，都会引发不匹配types错误，因为它只需要MailItemtypes的对象。

您只需要将myItemvariables的声明更改为：

 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