Le fichier à télécharger contient:
Mise en œuvre: (voir Module_Test)
- Le Module_MailOutlook à copier / intégrer dans le Projet VBA
Il contient:
- Une structure d'interface (Type OUTLOOK_DATA) dont les éléments sont utilisés pour l'envoi du mail,
- La Function MailOutlook() à appeler pour envoyer le mail.
- Le Module_Test qui est un exemple de mise en œuvre de l'envoi de mail Outlook
- Nécessite évidemment la présence d'Outlook installé sur le PC et d'au moins 1 compte défini.
- Permet l'envoi de pièces jointes.
- Permet l'ajout d'images placées dans le corps du mail.
- Permet l'ajout de plages de cellules (Ranges) transformées en images placées dans le corps du mail (ajout V2).
- Permet l'ajout de plages de cellules (Ranges) converties en HTML dans le corps du mail (ajout V3).
- D'autres options pourront être intégrées au fur et à mesure des propositions / demandes des XLDNautes.
- V1 - Initiale.
- V2 à V5 voir onglet Mises à jour.
- V6 - Correction pour restituer le .Body de la structure d'interface après l'appel de la fonction qui le modifie et permettre des appels successifs pour envoyer le même mail avec seulement un .To et/ou .CC et/ou .Bcc différents.
VB:
'----------------------------------------------------------------------------------
'Structure d'interface pour l'envoi d'un mail Outlook via la fonction MailOutlook()
'----------------------------------------------------------------------------------
Public Type OUTLOOK_DATA
SendUsingAccount As Variant 'Nom du compte Outlook à utiliser (ex.:moncompte@domaine.com)
'ou bien
'Numéro de séquence (1-n) du compte Outlook à utiliser
'Si SendUsingAccount = 0, la liste des comptes est proposée pour un choix
ReadReceiptRequested As Boolean 'True ou False
Importance As Integer 'Low = 0, Normal = 1, High = 2
To As String 'Adresses mail des destinataires séparées par ";"
CC As String 'Adresses mail des destinataires en copie séparées par ";"
Bcc As String 'Adresses mail des destinataires en copie masquée séparées par ";"
Subject As String 'Objet du mail
BodyFormat As Integer 'olFormatPlain = 1, olFormatHTML = 2, olFormatRichText = 3, olFormatUnspecified = 0
Body As String 'Message
TabEmbbededImages() As String 'Tableau des chemins complets des images intégrées dans le corps du mail
'Dans le .Body, utiliser les tags <EmbbededImage1>, <EmbbededImage2>, etc...
'pour y faire référénce
TabRangesToImages() As Range 'Tableau des Ranges à convertir en images intégrées dans le corps du mail
'Dans le .Body, utiliser les tags <RangeToImage1>, <RangeToImage2>, etc...
'pour y faire référénce
TabRangesToHTML() As Range 'Tableau des Ranges à convertir en HTML intégrés dans le corps du mail
'Dans le .Body, utiliser les tags <RangeToHTML1>, <RangeToHTML2>, etc...
'pour y faire référénce
RangesToHTMLIncludeObjects As Boolean 'False pour ne récupérer que les cellules du Range et leurs formats
'True pour inclure les objets (Formes, Images, Boutons) du Range dans le HTML
'Attention avec True: le résultat n'est WYSIWYG que pour Outlook en envoi et en
'réception de mail. Pour les Webmails et les clients POP3 ou IMAP le codage HTML
'généré par Outlook ne résulte pas en une représentation 100% WYSIWYG.
TabAttachments() As String 'Tableau des chemins complets des pièces jointes
Action As String '"Display", "PrintOut", "Save", "Send"
End TypeMise en œuvre: (voir Module_Test)
- Déclarer et valoriser la structure d'interface ,
- Appeler la fonction d'envoi de mail Outlook (avec la structure d'interface en paramètre).
VB:
'-------------------------------------------------
'Exemple d'utilisation de l'Interface Mail OutLook
'-------------------------------------------------
Sub Test()
Dim TblParamètres As ListObject
Dim OutLookInterface As OUTLOOK_DATA
'Tableau des paramètres de la feuille
Set TblParamètres = ActiveSheet.ListObjects(1)
'----------------------------------------
'Valorisation de la structure d'interface
'----------------------------------------
With OutLookInterface
'.SendUsingAccount = moncompte@domaine.com"
.SendUsingAccount = 0 '0 pour choisir le compte OutLook à utiliser
.ReadReceiptRequested = False 'Pas d'Accusé de Réception demandé
.Importance = 1 'Normale
'.To = "destinataireTo1@domaine.com;destinataireTo2@domaine.com"
.To = TblParamètres.DataBodyRange.Cells(1, 2).Value
'.CC = "destinataireCc1@domaine.com;destinataireCc2@domaine.com"
'.Bcc = "destinataireBcc1@domaine.com;destinataireBcc2@domaine.com"
.Subject = TblParamètres.DataBodyRange.Cells(2, 2).Value
'.Body = "<EmbbededImage1><BR>Bonjour<BR>Comment ça va ?<BR>" & _
"Le premier tableau se présente comme ça:<BR><RangeToImage1><BR>" & _
"Et voici le 2ème tableau:<BR><RangeToImage2><BR>" & _
"que je te mets aussi sous forme de HTML avec ses objets:"<BR>" & _
"<RangeToHTML1><BR>" & _
"Joe<BR><EmbbededImage2>"
.Body = TblParamètres.DataBodyRange.Cells(3, 2).Value
.BodyFormat = 2 'Pour HTML
'
'ReDim .TabEmbbededImages(1 To 2)
'.TabEmbbededImages(1) = "H:\Téléchargements\Image1.jpg"
'.TabEmbbededImages(2) = "H:\Téléchargements\Image2.jpg"
'
'ReDim .TabRangesToImages(1 To 2)
'Set .TabRangesToImages(1) = ActiveSheet.[C9:E11]
'Set .TabRangesToImages(2) = ActiveSheet.[C13:G20]
'
ReDim .TabRangesToHTML(1 To 1)
Set .TabRangesToHTML(1) = ActiveSheet.[C9:G20]
.RangesToHTMLIncludeObjects = True
'
'ReDim .TabAttachments(1 To 3)
'.TabAttachments(1) = "H:\Téléchargements\Attachment1.pdf"
'.TabAttachments(2) = "H:\Téléchargements\Attachment2.pdf"
'.TabAttachments(3) = "H:\Téléchargements\Attachment3.pdf"
'
.Action = "Send"
'-------------
'Envoi du mail
'-------------
If MailOutlook(OutLookInterface) Then MsgBox Application.Proper(.Action) & " mail réussi."
End With
End Sub- Version
- V4