Plusieurs feuilles en pdf par email

Bonjour

j'ai une macro qui fonctionne plutôt bien et permet d'enregistrer plusieurs feuille de mon classeur en pdf avec un nom de fichier voulu.

J'aimerai savoir si il est possible de joindre se fichier pdf, à un email avant de finir l'enregistrement ou après, un peu a l'identique de :

Application.Dialogs(xlDialogSendMail).Show

Voilà mon code :

Sub PDF()

Sheets(Array("Intro", "CAgen", "CAgen_Mois", "CA_invoice", "Catalogue")).Select

' PDF input box
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'folder local
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'Arrange le nom
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'Créer un nom spécifique de fichier et pdf
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'Choisir le répertoire
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=Sheets("Filtre").Range("A18") & "_" & Sheets("Filtre").Range("C22") & Sheets("Filtre").Range("D22"), _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export PDF
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    'confirmation message
    MsgBox "Le fichier PDF est Créé" _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Sheets("Intro").Select
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler

    End Sub

merci !

Salut Dawid92

Oui, tu peux regarder dans les sujets similaires en bas de cette page

A+

Merci je vais voir ça et me permettrai de revenir de ce côté si j'ai des problèmes d'adaptation

Re bonjour

Alors j'ai réussi une première partie, le mail, le pdf fonctionne quand le nom du fichier et défini et reste fixe.

Mais j'aimerai que le nom du fichier puisse changer et être envoyer automatiquement.

Sub Macro1()
'
' Macro1 Macro
'

'
    Dim myfile As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim olFormatHTML As String

    myfile = Sheets("Filtre").Range("A18") & "_" & Sheets("Filtre").Range("C22") & Sheets("Filtre").Range("D22")

    Sheets(Array("CAgen", "CAgen_Mois", "CA_invoice", "Catalogue")).Select
    ChDir "W:\David\Email"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile, Quality:=xlQualityStandard, IncludeDocProperties _
        :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    FileAttach = "myfile"

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
     strbody = "Information sur la mise à jour"
    On Error Resume Next
        With OutMail
            .To = Sheets("Filtre").Range("R18")
            .BCC = ""
            .Subject = "Djeco statistics "
            .BodyFormat = olFormatHTML
          .HTMLBody = "Bonjour Please find attached statistics for the month, David"
            .Attachments.Add enregistrement2_PDF
            .Attachments.Add (FileAttach)
            .OriginatorDeliveryReportRequested = False
            .ReadReceiptRequested = False
            .Display

        End With
            On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing

    'retour
    Worksheets("Intro").Activate
    Range("A1").Select

End Sub

merci

Salut Dawid

C'est presque parfait

Il faut juste remplacer

FileAttach = "myfile"

Par

FileAttach = MyFile & ".pdf"

Il faut supprimer les guillemets autour de ta variable

A+

merci beaucoup Bruno

ça ouvre outlook malheureusement, la pièce jointe ne s'attache pas

Je remets le code complet au cas ou

Sub Email()

    Dim Myfile As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim olFormatHTML As String

    Myfile = Sheets("Filtre").Range("A18") & "_" & Sheets("Filtre").Range("C22") & Sheets("Filtre").Range("D22")

    Sheets(Array("CAgen", "CAgen_Mois", "CA_invoice", "Catalogue")).Select
    ChDir "W:\David\Email"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Myfile, Quality:=xlQualityStandard, IncludeDocProperties _
        :=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    FileAttach = Myfile & ".pdf"

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
     strbody = "Information sur la mise à jour"
    On Error Resume Next
        With OutMail
            .To = Sheets("Filtre").Range("R18")
            .BCC = ""
            .Subject = "Statistics of the months "
            .BodyFormat = olFormatHTML
          .HTMLBody = "Bonjour Please find attached statistics for the month, David"
            .Attachments.Add enregistrement2_PDF
            .Attachments.Add (FileAttach)
            .OriginatorDeliveryReportRequested = False
            .ReadReceiptRequested = False
            .Display

        End With
            On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing

    'retour
    Worksheets("Intro").Activate
    Range("A1").Select

End Sub

J'avoue que je suis perdu...

merci

Bruno merci !

J'ai trouvé tout la finalité, il fallait mettre le chemin complet

FileAttach = "W:\David\Email\" & Myfile & ".pdf"

Merci encore pour cette aide précieuse !