Sub EnvoieMail_Descriptif()
Dim NomFic As String, EmplacementFichier
'Macro qui crée un nouveau email pour envoie d'une ou plusieurs fiches contacts
'Définit le chemin d'accès jusqu'au fichier à mettre en pièce jointe
EmplacementFichier = Sheets("Fiche_contact").Range("W4").Value
If Right(EmplacementFichier, 1) <> "\" Then EmplacementFichier = EmplacementFichier & "\"
' Récupérer le nom du fichier en entier
NomFic = Dir(EmplacementFichier & "*_Descriptif.pdf")
'Affiche un message si aucun emplacement dans la BDD Vendeur (Colonne AO) n'a été précisé
'Envoie par défaut un mail sans pièce jointe
If Sheets("Fiche_contact").Range("W4").Value = "" Then
Reponse = MsgBox(Document & " Pas d'emplacement précisé dans BDD Vendeur Col AO", 0) = vbCancel
EnvoieMail
Else:
'Déclenche l'ouverture d'un nouveau email
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
'Définie la zone où se situe le texte du corps du mail sur le fichier excel
For lig = 23 To 42
For col = 6 To 6
mytx = mytx & Sheets("Program").Cells(lig, col) & " "
Next
mytx = mytx & vbCr
Next
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
With olmail
.To = [Fiche_contact!W2] 'adresse destinataire
.Subject = ("Contact client") 'ici le sujet
.Body = mytx 'ici le corps du mail
No
.Attachments.Add EmplacementFichier & NomFic 'ici la pièce jointe
.Display '.Display /Send : Display correspond à l'affichage du message / Send demande un envoie direct
End With
End If
End Sub