Tworzenie listy dystrybucyjnej dla podanych adresów email
by vbatools on Jun.22, 2010, under Outlook, Porady
Microsoft Outlook nie posiada mechanizmu, dzięki któremu możemy wkleić kilka adresów email osadzonych w pamięci, z których byłaby utworzona lista dystrybucyjna. Zwykle proces ten jest realizowany adres po adresie w kreatorze listy, poprzez wybranie adresata lub wpisanie pojedynczego adresu.
Poniższa procedura po wklejeniu co najmniej dwóch adresów email oddzielonych znakiem „;” w wyświetlonym oknie i podaniu nazwy listy dystrybucyjnej utworzy ją, a następnie wyświetli ją na ekranie użytkownika.
Option Explicit
Sub Tworzenie_list_dystrybucyjnych()
'MVP OShon from VBATools.pl
Dim Message$, nazwa_listy$, Adresy$, x&
Message = "Wklej adresy Email rozdzielnone znakiem '';''"
Adresy = Trim(InputBox(Message, " Tworzenie listy dystrybucyjnej"))
If Len(Adresy) > 0 Then
On Error GoTo blad
If InStr(1, Adresy, ";") > 0 Then
Message = "Podaj nazwę dla zakładanej listy dystrybucyjnej." & vbCr _
& "Wszystkie poprawne adresy zostaną podłączone do tej grupy."
nazwa_listy = Trim(InputBox(Message, " Tworzenie listy dystrybucyjnej"))
nazwa_listy = Replace(nazwa_listy, ";", " ")
nazwa_listy = Replace(nazwa_listy, "(", vbNullString)
nazwa_listy = Replace(nazwa_listy, ")", vbNullString)
If Len(nazwa_listy) = 0 Then GoTo nie_podano_nazwy
Dim oContactFolder As MAPIFolder
Dim oDistList As DistListItem
Dim oMailItem As MailItem
Dim oRecipients As Recipients
Dim oRecipient As Recipient
Set oContactFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set oDistList = oContactFolder.Items.Add(olDistributionListItem)
With oDistList
.DLName = nazwa_listy
.Save
End With
Set oDistList = oContactFolder.Items(nazwa_listy)
Set oMailItem = Application.CreateItem(olMailItem)
Set oRecipients = oMailItem.Recipients
Dim temp() As String, abc&
abc = 0
temp() = Split(Left$(Adresy, Len(Adresy) - 1), ";")
While (abc <= UBound(temp()))
If temp(abc) Like "*@*.*" Then
oRecipients.Add (temp(abc))
x = x + 1
End If
abc = abc + 1
Wend
oRecipients.ResolveAll
If x > 0 Then
With oDistList
.AddMembers oRecipients
.Save '<-jeśli chcesz zapisać
.Display 0 '<-jeśli chcesz wyświetlić
End With
Else
oDistList.Delete
End If
Set oDistList = Nothing
Set oMailItem = Nothing
Set oRecipients = Nothing
Else
brak_conajmniej_2:
MsgBox "Lista dystrybucyjna nie została utworzona." & vbCr _
& "Aby utworzyć Listę dystrybucyjną należy podać wkleić" & vbCr _
& "conajmniej 2 adresy rozdzielone znakiem '';''.", vbExclamation, " Informacja o błędzie"
End If
Else
GoTo brak_conajmniej_2
End If
Exit Sub
nie_podano_nazwy:
MsgBox "Lista dystrybucyjna nie została utworzona." & vbCr _
& "Aby utworzyć Listę dystrybucyjną należy" & vbCr _
& "podać nazwe dla grupy odbiorców.", vbExclamation, " Informacja o błędzie"
Exit Sub
blad:
MsgBox "Błąd procedury: ''Tworzenie_list_dystrybucyjnych''" & vbCr _
& Err.Number & vbCr _
& Err.Description, vbExclamation, " Informacja o błędzie"
End Sub
Aby osadzić procedurę „Tworzenie_list_dystrybucyjnych” pod przyciskiem w menu MS Outlook, polecam uwadze ten artykuł.
Postępowanie krokowe w makro:
- sprawdza, czy jest wpisane co najmniej 2 pozycje rozdzielone znakiem „;”
- tworzy listę dystrybucyjną o nazwie, jaka została podana w InputBoxie
- sprawdza czy podany adres zawiera znak małpy oraz co najmniej 1 kropkę
- dodaje adresy do utworzonej wcześniej listy dystrybucyjnej i zapisuje zmiany
- pokazuje efekt końcowy, otwierając listę dystrybucyjną (można wyłączyć)
Podobna procedura „zrob_liste_dla_zaznaczonych_wiadomosci” dostępna jest tutaj. Należy wiedzieć iż stosowanie list dystrybucyjnych może prowadzić do blokady konta przez administratorów serwerów. Aby tak się nie stało polecam stosowanie rozwiązania umożliwiającego wysyłanie wiadomości pojedynczo (z listy dystrybucyjnej).
(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.