1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
|
' Exemple de création d'une liste de distribution
Dim myOlApp As New Outlook.Application
Dim myDistList As Outlook.DistListItem
Dim myTempItem As Outlook.MailItem
Dim myRecipients As Outlook.Recipients
Set myTempItem = myOlApp.CreateItem(olMailItem)
Set myRecipients = myTempItem.Recipients
Screen.MousePointer = vbHourglass
Set conn = CreateObject("ADODB.RecordSet")
MySql = ""
MySql = MySql & "SELECT EMAIL "
MySql = MySql & "FROM MATABLE "
MySql = MySql & "order by NOM, PRENOM "
conn.Open MySql, DriverAccess & BaseAccess
If Not conn.EOF Then
conn.MoveFirst
CptList = 1
Do While Not conn.EOF
Set myDistList = myOlApp.CreateItem(olDistributionListItem)
myDistList.DLName = "Groupe" & CptList
z = 0
Do While z < 150 And Not conn.EOF
Email = conn("EMAIL")
z = z + 1
myRecipients.Add Email
' Tentative de résolution de l'adresse
If Not myRecipients.Item(z).Resolve Then
myRecipients.Item(z).Delete
z = z - 1
End If
End If
conn.movenext
If conn.EOF Then Exit Do
Loop
myDistList.AddMembers myRecipients
myDistList.Save
' Suppression des membres
For i = myRecipients.Count To 1 Step -1
On Error Resume Next
myRecipients.Item(i).Delete
Err.Clear
Next i
Set myDistList = Nothing
CptList = CptList + 1
Loop
End If
Set myTempItem = Nothing
Set myRecipients = Nothing
Screen.MousePointer = Default
MsgBox "Terminé." |
Partager