Option Explicit
Sub SendMail(Dest As String, Echeance As String)
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.TaskItem
Dim myDelegate As Outlook.Recipient
Set myItem = myOlApp.CreateItem(olTaskItem)
myItem.Assign
Dim Mess As String
Mess = "Bonjour," & Chr(13)
Mess = Mess & "Vous avez été désigné comme pilote pour au moins une action corrective de la réclamation ci jointe." & Chr(13)
Mess = Mess & "Merci de bien vouloir traiter celle ci dans les meilleurs délais, compléter la date de validation et clôturer votre tâche dans Outlook." & Chr(13)
Mess = Mess & "Cordialement."
Set myDelegate = myItem.Recipients.Add(Dest) 'myItem.Recipients.Add(Range("AC3").Value)
myDelegate.Resolve
If myDelegate.Resolved Then
myItem.Subject = "action corrective suite réclamation"
myItem.Body = Mess
myItem.dueDate = Echeance 'Range("P33") 'échéance
myItem.ReminderTime = True 'Rappel
myItem.Display
myItem.Attachments.Add "S:\Réclamations\" & A & "-" & B & "-" & MaDate & ".xlsm"
myItem.Send
End If
End Sub
Sub Demo()
Dim r As Range
For Each r In Feuil1.[A2:A5] 'LIGNE A ADAPTER A TON BESOIN
SendMail r.Value, r.Offset(0, 16).Value
Next
End Sub