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 47 48 49 50
| Sub Envoi_Documents()
'Requiert une référence à la bibliothèque d'objets Outlook
Dim Applic_Outlook As Outlook.Application
Dim MonItem As Outlook.MailItem
Dim Document As Range
Dim Fichier_joint As String
Sheets("Mail").Visible = True
Sheets("Mail").Select
Application.ScreenUpdating = True
'Crée l'objet Outlook
Set Applic_Outlook = New Outlook.Application
'Parcourt en boucle les lignes
For Each Document In Sheets("Mail").Range("pièces")
'Obtenir les données
Objet_Mail = Document.Offset(0, -1)
Adresse_Mail = Document.Offset(0, -3)
corp_message = Document.Offset(0, 4)
copie = Document.Offset(0, -2)
'Créer l'élément de mail et le transmettre
Set MonItem = Applic_Outlook.CreateItem(olMailItem)
With MonItem
.To = Adresse_Mail
.Subject = Objet_Mail
If Not IsEmpty(copie) Then .CC = copie
.Categories = "Daily"
.Body = corp_message
Fichier_joint = Document
.Attachments.Add Fichier_joint
For I = 1 To 2
If Not IsEmpty(Document.Offset(0, I)) And Document.Offset(0, I) <> "" Then
Fichier_joint = Document.Offset(0, I).Value
.Attachments.Add Fichier_joint
End If
Next
.Display
End With
Application.wait (Now + TimeValue("0:00:01"))
AppActivate Objet_Mail & " - Message", 0 ' Active Outlook
SendKeys "%v", True ' Envoi du message
Next
Set Applic_Outlook = Nothing
End Sub |
Partager