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
|
' ---
' ENVOI D'UN EMAIL AVEC PIECES JOINTES VIA OUTLOOK
' ---
'
Function OutlookMailAvecPJ(ByVal strDest As String, _
strSujet As String, _
strMsg As String, _
astrPiecesJointes() As String)
Dim olApp As Outlook.Application
Dim miEmail As Outlook.MailItem
Dim rcDest As Outlook.Recipient
Dim varFichier As Variant
' Initialiser un objet Outlook
Set olApp = New Outlook.Application
' Créer le message
Set miEmail = olApp.CreateItem(olMailItem)
' Renseigner le message
With miEmail
' Destinataire
Set rcDest = .Recipients.Add(strDest)
rcDest.Type = olTo
' Sujet et corps du message
.Subject = strSujet
.Body = strMsg & vbCrLf & vbCrLf
' Ajouter les pièces jointes
For Each varFichier In astrPiecesJointes
' Vérifier que le fichier existe
If Dir(varFichier) <> "" Then .Attachments.Add varFichier
Next
' Afficher le message
.Display
' .Send
End With
' Libérer les objets
Set miEmail = Nothing
Set olApp = Nothing
End Function |
Partager