A macro a seguir, executada uma vez, criará uma Pasta de Pesquisa que mostra persistentemente as mensagens da pasta Itens Enviados que foram enviadas para apenas um único destinatário especificado.
No Outlook, abra o editor VBA usando Alt+ F11e cole o código no editor. Selecione uma mensagem que você enviou apenas para seu amigo Zeev e execute a macro. Pode ser necessário definir a segurança da macro como baixa para executar a macro.
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
Macro é uma versão modificada do código de Como criar uma pasta de pesquisa do Outlook usando o VBA
"urn:schemas:httpmail:displayto" LIKE '%;%'
.