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 51 52 53 54 55 56 57 58 59 60 61 62 63 64
| Sub Confirmation_Date_Pose()
Dim Destinataire_A As Variant
Dim Destinataire_CC As Variant
Dim Objet_mail As Variant
Dim messagerie As Object
Dim Email As Object
Dim Message As Variant
Dim Date_de_pose As Variant
Dim Duree_de_pose As Variant
'Destinataire_A
Destinataire_A = f.Cells(Ligne_Data_LOOK, 18)
'Destinataire_CC
Destinataire_CC = "af.rey@zurbuchensa.ch"
'Objet du mail
Objet_mail = "Confirmation de la date de pose " & f.Cells(Ligne_Data_LOOK, 5) & "." & f.Cells(Ligne_Data_LOOK, 6) & " " & f.Cells(Ligne_Data_LOOK, 8) & " " & f.Cells(Ligne_Data_LOOK, 11)
If MsgBox("Envoyer le à " & Destinataire_A & " ?", vbYesNo, "Mail") = vbYes Then
Date_de_pose = f.Cells(Ligne_Data_LOOK, 29)
Duree_de_pose = f.Cells(Ligne_Data_LOOK, 30)
'Corps du mail
Message = "<p style='font-family:calibri;font-size:11pt;'>" & _
"<I>" & _
"Vérifier les destinataires du mail" & _
"<br>Vérifier la signature du mail" & _
"<br>_________________________________________________________" & _
"<br>Effacer tout le texte ci-dessus avant d'envoyer ce mail" & _
"<br></I>" & _
"Bonjour," & _
"<br><br>Pourriez-vous nous confirmer la date de pose du " & Date_de_pose & " pour une durée de " & Duree_de_pose & " jours ouvrables ?" & _
"<br><br>Pour pouvoir réaliser la pose à la date convenue, les points suivants doivent être réalisés : " & _
"<br><B>" & _
"<br> - Mise au hors d'eau du bâtiment réalisée." & _
"<br> - Une référence à + 1 mètre du sol doit être tracée à tous les étages." & _
"<br> - Les échafaudages et tous les gardes corps en place." & _
"<br> - Plateforme de déchargement en place." & _
"<br> - Accès et zone de stockage à disposition." & _
"<br> - Grue de chantier à disposition pour la distribution des éléments et des verres." & _
"</B>" & _
"<br><br>Dans lattente de votre confirmation, je vous souhaite une bonne fin de journée" & _
"<br>Meilleures salutations"
'Création du mail avec Outlook
Const wdCharacter = 1 'Pour supprimer le double retour ligne dans le mail
Const wdMove = 0 'Pour supprimer le double retour ligne dans le mail
Set messagerie = CreateObject("Outlook.Application")
Set Email = messagerie.CreateItem(0) '0=Mail, 1=RDV, 2=Contact, 3=Tache, 6=Objet outlook
Boutons_Fonctions.Signature_Mail_externe 'Lancer la macro pour renseigner la variable Signature
With Email
.To = Destinataire_A
.CC = Destinataire_CC
.Bcc = "archi-dt@zurbuchensa.ch"
.Subject = Objet_mail
.HTMLBody = "<p style='font-family:Calibri Light;font-size:11pt;'>" & Message ' & Signature & "</p>"
.Display
Set wdeditor = Email.GetInspector.WordEditor 'Pour supprimer le double retour ligne dans le mail
Set wordSelection = wdeditor.Application.Selection 'Pour supprimer le double retour ligne dans le mail
wordSelection.WholeStory 'Pour supprimer le double retour ligne dans le mail
wordSelection.Style = wdeditor.Styles("Normal") 'Pour supprimer le double retour ligne dans le mail
wordSelection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdMove 'Pour supprimer le double retour ligne dans le mail
End With
Set Email = Nothing
Set messagerie = Nothing
Unload USF_Details_Commande
Unload Me
End If
End Sub |
Partager