Envoyer par mail tous les fichiers pdf d'un répertoire donné
Bonjour à tous,
J'ai créé une macro permettant de créer un mail avec les destinataires, l'objet, le corps du mail etc.. J'arrive à mettre en pièce jointe un fichier pdf situé dans le même répertoire que mon fichier excel et qui par chance à le même nom.
Cependant, mon souhait et d'ajouter en pièce jointe de ce mail tous les fichiers "*.pdf" du répertoire contenant mon fichier excel.
Pourriez-vous m'aider à cela svp?
D'avance merci!
"
Sub Envoyer_Mail()
Dim Adresse, Nom As String
Dim Appli_Outlook, Mon_Mail As Object
Adresse = ActiveWorkbook.Path
Nom = Split(ActiveWorkbook.Name, ".")(0)
Set Appli_Outlook = CreateObject("Outlook.Application")
Set Mon_Mail = Appli_Outlook.CreateItem(0)
On Error Resume Next
Range("O5:R15").Select
Selection.Copy
Set Corps_du_mail = Mon_Mail.GetInspector.WordEditor
Mon_Mail = Corps_du_mail.Range.PasteAndFormat(Type:=wdFormatOriginalFormatting)
Mon_Mail.To = Range("aa10").Value
Mon_Mail.Subject = Range("O3").Value
Mon_Mail.Attachments.Add Adresse & "\" & "*.pdf"
Mon_Mail.Display
On Error GoTo 0
Set Mon_Mail = Nothing
Set Appli_Outlook = Nothing
End Sub
"
En fait je souhaite un bout de code me permettant de déterminer tous les fichiers pdf dans un répertoire donné puis les ajouter en pièce jointe au mail que j'ai créé.
Si quelqu'un pouvait m'aider ça serait super!
BeniQuality a écrit :En fait je souhaite un bout de code me permettant de déterminer tous les fichiers pdf dans un répertoire donné puis les ajouter en pièce jointe au mail que j'ai créé.
Si quelqu'un pouvait m'aider ça serait super!
Bonjour,
Pour moi comme ça de but en blanc, je dirais que je ferais une boucle à ce niveau : Mon_Mail.Attachments.Add Adresse & "\" & "*.pdf"
je m'explique, ça donnerait ca :
adresse = chemin_relatif & "\"
For each fichier in Adresse
if fichier like "*.pdf" then
Mon_Mail.Attachments.Add adresse & "\" & fichier
end if
Next
Pars sur cette base tu verras tu y arriveras si tu butes contacte moi je t'aiderai a mettre a plat le code.
Cdt,
Bonjour,
désolé pour la réponse tardive et merci de ton aide. J'ai finalement réussi à trouver une boucle permettant de rechercher des fichier en fonction de leur extension et ça donne ça:
Sub Envoyer_Mail()
Dim Adresse, Nom As String
Dim Appli_Outlook, Mon_Mail As Object, Robert As Object
Dim i As Long, Ligne As Long, Texte As String
Dim fs
Dim Tableau(20)
Adresse = ActiveWorkbook.Path
Nom = Split(ActiveWorkbook.Name, ".")(0)
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
On Error GoTo 0
Set fs = Nothing
On Error GoTo Err1
Nom = Dir(Adresse & "\*" & ".pdf")
i = 0
Tableau(i) = Adresse & "\" & Nom
Do
Nom = Dir
If Nom <> "" Then
Tableau(i + 1) = Adresse & "\" & Nom
End If
i = i + 1
Loop Until Nom = ""
Err1:
Set Appli_Outlook = CreateObject("Outlook.Application")
Set Mon_Mail = Appli_Outlook.CreateItem(0)
On Error Resume Next
Range("AB18:AE45").Select
Selection.Copy
Set Corps_du_mail = Mon_Mail.GetInspector.WordEditor
Mon_Mail = Corps_du_mail.Range.PasteAndFormat(Type:=wdFormatOriginalFormatting)
Mon_Mail.To = Range("aa10").Value
Mon_Mail.Subject = Range("AB16").Value
For j = 0 To i - 1
Mon_Mail.Attachments.Add Tableau(j)
Next
Mon_Mail.Display
On Error GoTo 0
Set Mon_Mail = Nothing
Set Appli_Outlook = Nothing
End Sub
Ca fonctionne parfaitement.
Je pense que nous pouvons considérer ce post comme clôturé!
A+