Wyszukiwanie wiadomości po treści tematu

Jeden z użytkowników forum miał problem z mechanizmem Windows Search 4.0, który zwracał nadmierną ilość wiadomości dla wcześniej określonego tematu.

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 On
Dim szukana$, szukac_dalej As Object, iFolder$
Dim oFolder As MAPIFolder, oMail As MailItem, x&

Sub szukaj_wiadomosci_po_temacie()
    iFolder = Application.ActiveExplorer.CurrentFolder
    szukana = InputBox("Podaj dokładną treść tematu wiadomości znajdującej się w folderze " & XXX(34) & _
                    iFolder & XXX(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 " & XXX(34) & iFolder & XXX(34), vbExclamation, "Szukanie cząstkowe - O'Shon VBATools.pl")
    End If
End Sub

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

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

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

    FindTematCzastkowo = False
    For x = 1 To oFolder.Items.Count
        If oFolder.Items(x).Class = 43 Then
            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

    oFolder = Nothing
    oMail = Nothing
End Function

Osadzenie procedury znajdziesz w artykule: Instalacja i uruchamianie makr. Czynność taką można przypisać do przycisku na pasku lub dodać do menu szybkiego wyboru zgodnie z artykułem: Uruchamianie makr przyciskiem na pasku narzędzi. (c) Shon Oskar – www.VBATools.pl

© Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.