Bir kez çalıştırılan aşağıdaki makro, Gönderilen Öğeler klasöründen yalnızca belirtilen tek bir alıcıya gönderilen iletileri sürekli olarak gösteren bir Arama Klasörü oluşturur.
Outlook'ta Alt+ kullanarak VBA düzenleyicisini açın F11ve kodu düzenleyiciye yapıştırın. Yalnızca arkadaşınız Zeev'e gönderdiğiniz bir mesajı seçin ve makroyu çalıştırın. Makroyu çalıştırmak için makro güvenliğini düşük olarak ayarlamanız gerekebilir .
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
Makro, VBA kullanarak bir Outlook arama klasörü nasıl oluşturulur bölümündeki değiştirilmiş bir kod sürümüdür
"urn:schemas:httpmail:displayto" LIKE '%;%'
.