La siguiente macro ejecutada una vez creará una Carpeta de búsqueda que muestra de manera persistente mensajes de la carpeta Elementos enviados que se enviaron a un solo destinatario especificado.
En Outlook, abra el editor VBA con Alt+ F11y pegue el código en el editor. Seleccione un mensaje que envió solo a su amigo Zeev y luego ejecute la macro. Es posible que deba establecer la seguridad de macro en baja para ejecutar la 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 es una versión modificada del código de Cómo crear una carpeta de búsqueda de Outlook usando VBA
"urn:schemas:httpmail:displayto" LIKE '%;%'
.