Embedded Files
Plusieurs PJ
'ENVOYER UN MAIL DEPUIS ACCESS, AVEC PLUSIEURS PIECES JOINTES
' ---
' Entrée : strEmail <- Adresse e-mail du destinataire
' strObj <- Objet du courrier
' strMsg <- Corps du message
' blnEdit <- True pour pouvoir modifier le courrier avant envoi
' False pour expédier le courrier directement.
' astrFichiers <- Tableau des pièces jointes
' Remarques : Le mail est expédié via Microsoft Outlook
' plutôt que via SendObject.
Public Sub SendOLMailMPJ( _
ByVal strEmail As String, _
ByVal strObj As String, _
ByVal strMsg As String, _
ByVal blnEdit As Boolean, _
Optional ByVal avarFichiers As Variant)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
' Créer une instance d'Outlook
On Error GoTo OLMailErr
Set ol = New Outlook.Application
' Créer un objet Email
Set mi = ol.CreateItem(olMailItem)
' Paraméter le message
With mi
' .SentOnBehalfOfName = "contact@evolution-nord.com"
.To = strEmail
'.ReplyRecipients.Add "david@evolution-nord.com"
.Cc = encopie
.Subject = strObj
.Body = strMsg
' Joindre les pièces, s'il y en a
For Each varPJ In avarFichiers
If varPJ <> "" Then
.Attachments.Add (varPJ)
End If
Next
If blnEdit Then
.Display
Else
.Send
End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Sub
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
1 PJ
Public Sub SendOLMail2( _
ByVal strEmail As String, _
ByVal strObj As String, _
ByVal strMsg As String, _
ByVal blnEdit As Boolean, _
ByVal avarFichiers As Variant, ByVal encopie As String)
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
' Créer une instance d'Outlook
On Error GoTo OLMailErr
Set ol = New Outlook.Application
' Créer un objet Email
Set mi = ol.CreateItem(olMailItem)
' Paraméter le message
With mi
.SentOnBehalfOfName = "clara2@evolution-nord.com"
.To = strEmail
'.ReplyRecipients.Add "david@evolution-nord.com"
.Cc = encopie
.Subject = strObj
.Body = strMsg
' Joindre les pièces, s'il y en a
' For Each varPJ In avarFichiers
.Attachments.Add (avarFichiers)
' Next
If blnEdit Then
.Display
Else
.Send
End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Sub
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
Page updated
Google Sites
Report abuse