VBATools

Rozwiązaniem jest umieszczenie szukanej treści w apostrofach (Rys.1).

Rys.1 Dokładne wyszukiwanie w Microsoft Outlook

Metodą alternatywną jest umieszczenie kodu VBA, który będzie przeszukiwał w danym folderze maile o podanej treści. Poniższa procedura zawiera dwie metody wyszukania:

• Dokładną – gdzie wpisana w okno szukania treść musi dokładnie pasować (wielkość wpisywanych liter nie ma znaczenia),
• Cząstkową – gdzie treść powinna znajdować się w przeszukiwanym polu (w tym przypadku polu Tematu).

Obie funkcje są spięte tak, aby w przypadku braku pozytywnego rezultatu zaproponowały użytkownikowi druga metodę. Procedura dla obiektów, które spełniają zakładany warunek zostaną otwarte.

 Option Explicit
Dim szukana$, szukac_dalej As Variant, iFolder$
Dim oFolder As MAPIFolder, oMail As MailItem, x&

Sub szukaj_wiadomosci_po_temacie()
'MVP OShon from VBATools.pl
iFolder = Application.ActiveExplorer.CurrentFolder
szukana = InputBox("Podaj dokładną treść tematu wiadomości znajdującej się w folderze " & Chr(34) & _
 iFolder & Chr(34) & vbCr & vbCr & "Wielkość liter nie ma znaczenia.", _
 "Dokładne szukanie treści - O'Shon VBATools.pl")
If FindTematDokladnie(szukana) = False Then szukac_dalej = MsgBox("Brak wiadomości z podaną treścią tematu " & szukana & _
 "." & vbCr & "Czy chcesz wyszukać wiadomości w której szukane słowo znajduje się w temacie?", _
 vbExclamation + vbDefaultButton2 + vbYesNo, "O'Shon VBATools.pl")
If szukac_dalej = vbYes Then
 If FindTematCzastkowo(szukana) = False Then MsgBox "Niestety nie ma wiadomości z treścią " & szukana & _
 " w folderze " & Chr(34) & iFolder & Chr(34), vbExclamation, "Szukanie cząstkowe - O'Shon VBATools.pl"
End If
End Sub

Private Function FindTematDokladnie(tresc$) As Boolean
 tresc = """" & tresc & """"
 Set oFolder = Application.ActiveExplorer.CurrentFolder
 Set oMail = oFolder.Items.Find("[Subject]=" & tresc & "")

 FindTematDokladnie = False
 While Not oMail Is Nothing
 DoEvents
 oMail.Display 0
 FindTematDokladnie = True
 Set oMail = oFolder.Items.FindNext()
 Wend
 Set oFolder = Nothing
 Set oMail = Nothing
End Function

Private Function FindTematCzastkowo(tresc$) As Boolean
 If Len(Replace(tresc, Chr(34), vbNullString)) = 0 Then FindTematCzastkowo = True: Exit Function
 Set oFolder = Application.ActiveExplorer.CurrentFolder

 FindTematCzastkowo = False
 For x = 1 To oFolder.Items.Count
 If oFolder.Items(x).Class = 43 Then
 Set oMail = oFolder.Items(x)
 DoEvents
 If InStr(1, UCase(oMail.Subject), UCase(tresc)) > 0 Then
 oMail.Display 0
 FindTematCzastkowo = True
 End If
 End If
 Next x

 Set oFolder = Nothing
 Set oMail = Nothing
End Function