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

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
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