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
|
PublicSub mail(ByVal GROUPE AsString, OptionalByVal JOINTE AsString = "", OptionalByVal SUJET AsString = "", OptionalByVal BODY AsString = "", OptionalByVal dest AsString = "")
' FONCTION PERMETTANT D'ENVOYER UN MAIL AVEC UNE PIECE JOINTE
Dim MonOutlook AsNew Outlook.Application
Dim MonMessage As Outlook.MailItem
'Set MonOutlook = CreateObject("Outlook.Application")
' CREATION D'UN NOUVEAU MESSAGE
MonMessage = MonOutlook.CreateItem(0)
' DESTINATAIRE
Dim TO_Dest AsString
Dim i AsInteger
For i = 1 To MonOutlook.Session.AddressLists.Item("Contacts").AddressEntries.Item(GROUPE).Members.Count
If TO_Dest <> "" Then TO_Dest = TO_Dest & "; "
TO_Dest = TO_Dest & MonOutlook.Session.AddressLists.Item("Contacts").AddressEntries.Item(GROUPE).Members.Item(i)
Next
' DESTINATAIRE ( ENSEMBLE DE MAIL )
MonMessage.To = TO_Dest
MonMessage.CC = ""
' OBJET DU MESSAGE
MonMessage.Subject = SUJET
' LE MESSAGE
MonMessage.BODY = BODY
' AJOUT DE LA PIECE JOINTE ( CHEMIN COMPLET DEMANDEE )
If JOINTE <> "" Then
If Dir(JOINTE, vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbArchive) = "" Then
MsgBox("fichier introuvable !", vbCritical, "Attention")
MonOutlook = Nothing
MonMessage = Nothing
ExitSub
EndIf
MonMessage.Attachments.Add(JOINTE)
EndIf
' ENVOI DE L'EMAIL
MonMessage.Send()
MonOutlook.Quit()
MonOutlook = Nothing
MonMessage = Nothing
EndSub
|
