Wyszukanie adresu email na listach dystrybucyjnych
by vbatools on Nov.21, 2011, under Outlook, Porady
Jeden z moich znajomych nie pracuje już w branży, to też nie powinien otrzymywać informacji o stanach magazynowych, promocyjnych cenach etc… Chciałbym sprawdzić do jakich list dystrybucyjnych jest on przypisany.
To jeden ze scenariuszy “dlaczego szukamy adresu na listach emailingowych”. Poniżej podaje rozwiązanie w postaci kodu VBA, dzięki któremu użytkownik będzie miał podany wynik w postaci otwartych list dystrybucyjnych do których szukana osoba należy. Alternatywą jest podanie komunikatu z nazwami tych list.
Option Explicit Sub Lista_dyst_szukaj_email() 'MVP Shon Oskar from VBATools.pl Dim item, nIndex&, szukana$, czy, lista As New Collection Dim oDistList As DistListItem, oFolder As MAPIFolder, co_na_liscie$ 'Set oFolder = Application.ActiveExplorer.CurrentFolder 'w aktualnym folderze Set oFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts) 'w folderze kontaktów szukana = InputBox("Wpisz adres email którego szukasz!", _ "Szukanie w folderze " & oFolder & " na listach dystrybucyjnych") On Error GoTo blad For Each item In oFolder.Items If item.Class = 69 Then DoEvents Set oDistList = item If Not oDistList Is Nothing Then If oDistList.MemberCount > 0 Then For nIndex = 1 To oDistList.MemberCount If UCase(oDistList.GetMember(nIndex).Address) = UCase(szukana) Then _ lista.Add oDistList.DLName Next nIndex End If End If End If Next If lista.Count > 0 Then Beep czy = MsgBox("Znaleziono " & lista.Count & " list z wyszukiwanym adresem email." & vbCr & _ "Czy otworzyć znalezione listy?", vbQuestion + vbYesNo, "Otwieranie list dystrybucyjnych") If czy = vbYes Then For Each item In lista oFolder.Items.item(item).Display Next Else For Each item In lista co_na_liscie = co_na_liscie & item & "; " Next MsgBox "Adres: " & szukana & vbCr & _ "Znajduje się na następujących listach dystrybucyjnych:" & vbCr & _ vbCr & co_na_liscie End If Else MsgBox "Adresu '" & szukana & "' nie znaleziono na żadnej liście dystrybucyjnej w folderze " & oFolder.Name, _ vbInformation, "VBTools.pl" End If koniec: Set oDistList = Nothing Set oFolder = Nothing Exit Sub blad: MsgBox "Nr błedu:" & Err.Number & " " & vbCr & "Opis: " & Err.Description, vbExclamation, "VBATools.pl" Resume koniec End Sub
Polecam podobną procedurę Tworzenie listy dystrybucyjnej dla podanych adresów email oraz Tworzenie listy dystrybucyjnej na podstawie adresów z zaznaczonych wiadomości email
(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.