Следующий макрос, запущенный один раз, создаст папку поиска, которая постоянно показывает сообщения из папки «Отправленные», которые были отправлены только одному указанному получателю.
В Outlook откройте редактор VBA с помощью Alt+ F11и вставьте код в редактор. Выберите сообщение, которое вы отправили только своему другу Zeev, а затем запустите макрос. Для запуска макроса может потребоваться установить низкий уровень безопасности макросов.
Sub CreateSearchFolderForOneRecipient()
On Error GoTo Err_CreateSearchFolderForOneRecipient
' Get the email address from a selected message
Dim oMail As Outlook.MailItem
Set oMail = ActiveExplorer.Selection.Item(1)
strSearchFolderName = "Msgs sent only to " & oMail.To
If oMail.To = "" Then
Exit Sub
ElseIf InStr(1, oMail.To, ";") > 0 Then
Err.Raise Number:=vbObjectError + 1000, _
Description:="Selected message must have only 1 recipient in To: field"
End If
Dim strDASLFilter As String
' The trick to identifying messages sent to multiple recipients is the semi-colon ; delimiter.
' Semicolon can be searched using SQL DASL syntax but not in the Advanced Search form GUI
' Description of filter
' Line 1: Messages sent to specified recipient
' Line 2: 'To' field cannot contain semicolon
' LIne 3: 'CC' field must be empty
strDASLFilter = Chr(34) & "urn:schemas:httpmail:displayto" & Chr(34) & " = '" & oMail.To & "'" _
& " AND NOT " & Chr(34) & "urn:schemas:httpmail:displayto" & Chr(34) & " LIKE '%;%'" _
& " AND " & Chr(34) & "urn:schemas:httpmail:displaycc" & Chr(34) & " = ''"
Dim strScope As String
strScope = "'Sent Items'"
Dim objSearch As Search
Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, _
SearchSubFolders:=True, Tag:="SearchFolder")
' Save the search results to a searchfolder
objSearch.Save (strSearchFolderName)
Set objSearch = Nothing
Exit Sub
Err_CreateSearchFolderForOneRecipient:
MsgBox "Error # " & Err.Number & " : " & Error(Err)
End Sub
Макрос является модифицированной версией кода из Как создать папку поиска Outlook с использованием VBA
"urn:schemas:httpmail:displayto" LIKE '%;%'
.