Sub Email_DI()
Dim User As String
Dim Chemin As String
Dim NomDI As String
Dim mItem As MailItem
Dim Nom_client As String
Dim Email_SAV As String
Dim Email_TCI As String
Dim Email_TCS As String
Dim Nom_ATS As String
Dim Email_DTS As String
Dim Tel_ATS As String
Dim Fax_ATS As String
Dim Email_ATS As String
Dim Atelier As String
Dim Atelier2 As String
Dim Atelier3 As String
Dim Atelier4 As String
Dim N_DI As String
User = Application.UserName
Chemin = "C:\Users\" & User & "\Desktop\"
Set appOutlook = CreateObject("outlook.application")
Set mailoutlook = appOutlook.CreateItem(olMailItem)
With mailoutlook
Nom_client = Worksheets("D_Email").Range("A1").Value
Email_SAV = Worksheets("D_Email").Range("A2").Value
Email_TCI = Worksheets("D_Email").Range("A3").Value
Email_TCS = Worksheets("D_Email").Range("A4").Value
Nom_ATS = Worksheets("D_Email").Range("A5").Value
Email_DTS = Worksheets("D_Email").Range("A6").Value
Tel_ATS = Worksheets("D_Email").Range("A7").Value
Fax_ATS = Worksheets("D_Email").Range("A8").Value
Email_ATS = Worksheets("D_Email").Range("A9").Value
Atelier = Worksheets("D_Email").Range("A10").Value
Atelier2 = Worksheets("D_Email").Range("A11").Value
Atelier3 = Worksheets("D_Email").Range("A12").Value
Atelier4 = Worksheets("D_Email").Range("A13").Value
N_DI = Worksheets("D_Email").Range("A14").Value
.Attachments.Add "C:\Users\" & User & "\Desktop\" & N_DI & ".xlsm"
.To = Atelier & ";" & Atelier2 & ";" & Atelier3 & ";" & Atelier4 ' le destinataire
.cc = Email_TCI & ";" & Email_TCS & ";" & Email_SAV & ";" & Email_DTS
'.BCC =
.Subject = N_DI ' l'objet du mail
.HTMLBody = "Madame, Monsieur, <br><br>" _
& "Veuillez trouver ci-joint une DI pour action !!<br>" _
& "Merci de transmettre le rapport d'intervention à remplir sur site à votre intervenant.<br>" _
& "<br>" _
& "<br>" _
& "Nous restons à votre disposition pour tous renseignements complémentaires. <br><br>" _
& "Salutations distinguées/ Mit freundlichen Grüssen/ Kind regards <br>" _
& "<font color= red><br><br>" _
& "@Atelier : <font color= blue> A réception de cette demande d'intervention , merci de contacter le client sous 48 heures , afin et selon les cas suivants :<br>" _
& " - De convenir d'un date d'intervention avec le client si cela est possible dès à présent.<font color= blue><br>" _
& " - De lui signifier que vous avez bien pris en compte la demande et que vous êtes en attente de pièces de rechange de KSB.<br>" _
& " - Dès réception des pièces vous reprendrez contact avec le client pour convenir d'une date d'intervention.<font color= red><br><br>" _
& "@SAV :<br><br>" _
& "@DTS :<br><br><font color= Black>" _
& "" & Nom_ATS & "<br>" _
& "KSB S.A.S. - Service Clients <b><br>" _
& "Tel.: " & Tel_ATS & " - Fax.: " & Fax_ATS & " - Mail.: <font color= blue>" & Email_ATS & " <br><br> " _
.Display
End With
Set appOutlook = Nothing
Set mailoutlook = Nothing
Set mItem = 'récupérer le mail à suivre dans la boîte d'envoi ou un dossier
With mItem
'marquer l'email à partir d'aujourd'hui
.MarkAsTask olMarkToday
'définir le type de suivi
.FlagRequest = "Assurer un suivi"
'définir les dates
.TaskStartDate = #1/28/2015#
.TaskDueDate = #2/25/2015#
'définir le rappel
.ReminderSet = True
.ReminderTime = #1/30/2015 4:00:00 PM#
'enregistrer les modifs
.Save
End With
End Sub