Question

我正在努力自动执行定期任务。

搜索电子邮件收件箱（不是主Outlook帐户），查找包含以下内容的主题的项目：＆＃34;代理/附加＆＃34;。

Sub SrchRF4AAABonuses()
Dim myOlApp As New Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String

Set objNamespace = myOlApp.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%Acting / Additional%'"

Set filteredItems = objFolder.Items.Restrict(strFilter)

If filteredItems.Count = 0 Then
Debug.Print "No emails found"
Found = False
Else
Found = True
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
 Debug.Print itm.Subject
Next
End If ...

...

上面的代码搜索我的默认电子邮件（例如，jsmith @ example.com），但是，我有一个名为Retail Finance的辅助电子邮件（rfin@example.com），我想搜索那个e邮箱地址收件箱。如何修改我的代码才能完成此任务？

我是Outlook VBA的新手，对不起，如果这是基本的话。

Answer 1

如果这是委托Exchange邮箱，请使用Namespace.GetSharedDefaultFolder将其打开。如果它只是您当前个人资料中的其他商店，请在Namespace.Stores集合中找到该商店，然后致电Store.GetDefaultFolder。

Answer 2

此代码完成任务：

Sub Search_Inbox()

Dim objNamespace As Outlook.NameSpace
Dim olShareName As Outlook.Recipient
Dim olShareInbox As Outlook.Folder
Dim objFolder As Outlook.MAPIFolder
Dim filteredItems As Outlook.Items
Dim itm As Object
Dim Found As Boolean
Dim strFilter As String


Set objNamespace = Application.GetNamespace("MAPI")
Set olShareName = objNamespace.CreateRecipient("rfin@example.com")   'address

Set objFolder = objNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox)


strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%Acting / Additional%'"

Set filteredItems = objFolder.Items.Restrict(strFilter)

If filteredItems.Count = 0 Then
    Debug.Print "No emails found"
    Found = False

搜索辅助Outlook帐户收件箱

2 个答案: