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
|
Partager