VBATools

Wyszukanie adresu email na listach dystrybucyjnych

by 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.
:, ,

Leave a Reply