Envoi d'un pdf par mail

Le 21/10/2017 à 08:58

Bonjour,

Avec le code qui suit, je génère un PDF qui va dans un dossier bien précis et ensuite je dois envoyer ce PDF par mail.

Serait il possible que, et j'en doute pas, une fois créé il soit envoyé par Outlook directement mais en conservé une copie dans le dossier prévu à cet effet.

Sub Save_xls_to_pdf()
Dim dest As String
dest = "C:\Users\Charl3ne\Desktop\FICHES HORAIRES ETHAN\"
ActiveSheet.Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
dest & Format(Date, "dd ") & ActiveWorkbook.ActiveSheet.Name & Format(Time, " hh""h""mm"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub

Bonne journée et bonne vacances aux chanceux

Bayard

Le 21/10/2017 à 10:43

J'ai fais quelques recherches et j'ai trouvé ça

Sub Mail()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

sRep = "C:\Users\JC\Desktop\Test"
Set WshShell = Nothing
' Définit le nom du fichier à enregistrer
sNomFic = "test.pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "bayard@laloose.fr"
        .Cc = ""
        .Attachments.Add (sRep & "\" & sNomFic)
        .Subject = "test Sept 2017"
        .Display
        .send
    End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

ça marche pas mal mais il faut que je le colle dans toutes les feuilles car je ne trouve pas comment lui dire d'utiliser la feuille active et de récupérer son nom dans l'onglet.

Bonne journée

Le 21/10/2017 à 15:04

Bonjour Bayard,

Vois si ça te convient:

Sub SaveToPdfAndMail()

    Dim dest, PDF_PJ As String
    Dim OutApp, OutMail As Object

        With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    dest = "C:\Users\Charl3ne\Desktop\FICHES HORAIRES ETHAN\"

    PDF_PJ = dest & Format(Date, "dd ") & ActiveWorkbook.ActiveSheet.Name & Format(Time, " hh""h""mm") & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    PDF_PJ, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "bayard@laloose.fr"
        .Cc = ""
        .Attachments.Add PDF_PJ
        .Subject = "test Sept 2017"
        .Display
        .Send
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Le 21/10/2017 à 15:19

Bonjour Sequoyah,

Ca marche très bien sauf deux petites choses

Le fichier PDF créé ne va pas dans le dossier "test" mais sur le bureau "desktop" et devant le nom du fichier PDF j'ai le nom du dossier. "Test21 Février 2018 15h10.pdf" par exemple.

Le mot "Test" disparait du nom du fichier lorsque je le supprime du chemin "C:\Users\JC\Desktop\"

Voilà les news, merci déjà pour le travail fait.

Bonne continuation.

Le 21/10/2017 à 15:34

bayard a écrit :
je génère un PDF qui va dans un dossier bien précis et ensuite je dois envoyer ce PDF par mail.
Bayard

Bonjour Bayard,

J'ai simplement gardé le nom du fichier et le chemin que tu as proposé dans ta première question.

Le 21/10/2017 à 16:12

Oui j'ai bien vu mais par défaut quelque soit le chemin proposé, il n'y va pas.

Je viens d'essayer avec "D:\Documents\Excel", le fichier est copier dans Documents et s'appelle "excel et le nom du fichier"

L'erreur ne vient pas de toi

J'y perds mon latin,

Le 21/10/2017 à 16:30

Salut Bayard,

une petite correction, j'avais oubliè le chemin au moment d'enregistrer le PDF:

Sub SaveToPdfAndMail()

    Dim dest, PDF_PJ As String
    Dim OutApp, OutMail As Object

        With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    dest = "C:\Users\JC\Desktop\Test\"

    PDF_PJ = "test.pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    dest & PDF_PJ, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "bayard@laloose.fr"
        .Cc = ""
        .Attachments.Add PDF_PJ
        .Subject = "test Sept 2017"
        .Display
        .Send
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Le 21/10/2017 à 16:48

Avec la modif, le fichier va bien où il faut mais s'appelle "test.pdf" pas terrible

J'ai donc repris une partie de ma macro pour qu'il chope le bon nom ex: "21 Septembre 2017 16h38.pdf" mais , bien sur il y a un mais arrivé à la ligne ".Attachments.Add PDF_PJ" il ne trouve pas le fichier à joindre au mail

ça craint un peu

Le 21/10/2017 à 18:13

Bonjour Bayard,

J'espère avoir bien compris, voici le code:

Sub SaveToPdfAndMail()

    Dim dest, PDF_PJ As String
    Dim OutApp, OutMail As Object

        With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    dest = "C:\Users\JC\Desktop\Test\"

        PDF_PJ = dest & Format(Date, "dd mmmm yyyy ") & Format(Time, "hh""h""mm") & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    PDF_PJ, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = "bayard@laloose.fr"
        .Cc = ""
        .Attachments.Add PDF_PJ
        .Subject = "test Sept 2017"
        .Display
       .Send
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Le 21/10/2017 à 19:13

Mais, ça marche impeccablement

Je te remercie pour tout le temps que tu m'as accordé.

Passe une bonne soirée et A+

Edit: Voilà le code complet avec quelques modifications et encore Merci

Sub Save_To_Pdf_And_Mail()
Dim dest, PDF_PJ As String
Dim OutApp, OutMail As Object
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    dest = "C:\Users\JC\Desktop\Test\"
    PDF_PJ = dest & "heures de" & " " & ActiveWorkbook.ActiveSheet.Name & " " & "(" & Format(Date, "dd mmmm yyyy ") & ")" & ".pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    PDF_PJ, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False
    Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .To = "bayard@opps.net"
    .Cc = ""
    .Attachments.Add PDF_PJ
    .Subject = "Feuille d'heures de" & " " & ActiveWorkbook.ActiveSheet.Name
    .Body = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver en pièce jointe, la feuille d'heures de" & " " & ActiveWorkbook.ActiveSheet.Name & vbCrLf & vbCrLf & "Cordialement" & vbCrLf & vbCrLf & "Bayard"
    .Display
    .Send
End With
     With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Rechercher des sujets similaires à "envoi pdf mail"