VBATools

Wyszukiwanie wiadomości po treści tematu

by on Oct.04, 2010, under Outlook, Porady

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

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

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.

:, , , , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała