Excel vers PDF + envoi par mail

Bonjour à tous,

Je cherche à exporter automatiquement un Excel en PDF + l'envoyer par mail à une liste de personne présent dans des cellules. Il faudrait idéalement que le fichier s'appelle par le nom présent dans une cellule.J'ai eu un début de réponse avec ce code trouver ici :

VBA :Exporter d'Excel une facture en PDF et l'envoyer par mail avec outlook (excel-pratique.com)

De plus je souhaiterais en avoir 2 versions, une qui envoit le mail automatiquement et une autre qui demande de cliquer sur le bouton envoyer.

Sub exportPDF()

Dim oOutlook as object, oMail As Object
dim Nomdossier$, dossier$, PJ$

Nomdossier = Application.InputBox("DOSSIER D'ENREGISTREMENT", "ENREGISTREMENT EN PDF", "FACTURE PDF")
dossier = ThisWorkbook.Path & "\" & Nomdossier '<<< "\" sur windows !!!

If dir(dossier, vbdirectory) = "" Then MkDir (dossier)

with Sheets("FACTURE")
    PJ = dossier & "\FACTURE " & .Range("A4").Value & ".pdf"
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PJ, ignoreprintareas:=False
end with

Set oOutlook = Create.Object("Outlook.Application")
Set oMail = oOutlook.CreateItem(olMailItem)

With oMail
    .To = "adresse mail"
    .bcc = "mon adresse mail"
    .Subject = "Facture"
    .Body = "Bonjour," & vbCr & vbCr & "Je vous transmets la facture pour cette période." & vbCr & vbCr & "Cordialement,"
    .Attachments.Add PJ
    '.display
    .send
    .ReadReceiptRequested = True
End With

Set oMail = Nothing
set oOutlook = nothing

End Sub

J'ai une erreur qui intervient ici :

Set oOutlook = Create.Object("Outlook.Application"

"Object required"

Si quelqu'un peut m'expliquer également comment fontionne le système de dossier ligne (4 et 5) car je ne comprends pas cette ligne.

Merci d'avance

Bonjour Antoine_56610

C'est "CreateObject" et non "Create.Object"

De plus "olMailItem" ne semble pas définit vous aurez une erreur à ce niveau aussi

Soit vous mettez 0, soit vous définissez en tout début de module, une constante

Const olMailItem As Integer = 0

Voici le code en entier

Option Explicit

Const olMailItem As Integer = 0

Sub exportPDF()
  Dim oOutlook As Object, oMail As Object
  Dim Nomdossier$, dossier$, PJ$
  '
  Nomdossier = Application.InputBox("DOSSIER D'ENREGISTREMENT", "ENREGISTREMENT EN PDF", "FACTURE PDF")
  dossier = ThisWorkbook.Path & "\" & Nomdossier '<<< "\" sur windows !!!
  ' Si dossier inexsitant, le créer
  If Dir(dossier, vbDirectory) = "" Then MkDir (dossier)
  ' Exporter la feuille en PDF
  With Sheets("FACTURE")
      PJ = dossier & "\FACTURE " & .Range("A4").Value & ".pdf"
      .ExportAsFixedFormat Type:=xlTypePDF, filename:=PJ, ignoreprintareas:=False
  End With
  ' Créer le mail
  Set oOutlook = CreateObject("Outlook.Application")
  Set oMail = oOutlook.CreateItem(olMailItem)
  With oMail
      .To = "adresse mail"
      .bcc = "mon adresse mail"
      .Subject = "Facture"
      .Body = "Bonjour," & vbCr & vbCr & "Je vous transmets la facture pour cette période." & vbCr & vbCr & "Cordialement,"
      .Attachments.Add PJ
      '.display
      .send
      .ReadReceiptRequested = True
  End With
  ' Effacer les variable objet pour libérer la mémoire
  Set oMail = Nothing
  Set oOutlook = Nothing
End Sub

A+

Je pense une petite erreur de votre part à cette ligne sinon tout fonctionne:

Set oMail = oOutlook.CreateItem(olMailItem)  -> Set oMail = oOutlook.CreateItem(oMailItem)

Et concernant le fait de sélectionner les destinataire dans des cellules et le fait que mon fichier prennent le nom d'une cellule en particulier comment faire ?

En ce qui concerne le nom du fichier PDF, j'ai réussit en modifiant simplement la ligne d'exportation. Pour les destinataires c'est un peu plus complexe j'arrive à l'envoyer à 1 ou plusieurs personnes mais je ne sais pas comment gérer si une case est manquante car évidemment Excel me dis que l'adresse mail n'est pas bonne si la case est vide.

Petite modification du code car plus pratique pour moi comme ça.

Option Explicit

Sub EmailAttachmentRecipients()
  Dim oOutlook As Object, oMail As Object
  Dim Nomdossier$, dossier$, PJ$
  Const oMailItem As Integer = 0

  Nomdossier = Application.InputBox("Folder Name", "Save in PDF", "Master Supplier Approval Questionnaire")
  dossier = ThisWorkbook.Path & "\" & Nomdossier '<<< "\" sur windows !!!
  ' Si dossier inexsitant, le créer
  If Dir(dossier, vbDirectory) = "" Then MkDir (dossier)
  ' Exporter la feuille en PDF
  With Sheets("Front Sheet")
      PJ = dossier & "\Master Supplier Approval Questionnaire " & .Range("AP2").Value & ".pdf"
      .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PJ, ignoreprintareas:=False
  End With
'updateby Extendoffice
    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xRg As Range
    Dim xCell As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the arresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
    For Each xCell In xRg
        If xCell.Value Like "*@*" Then
            If xEmailAddr = "" Then
                xEmailAddr = xCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & xCell.Value
            End If
        End If
    Next
    With xMailItem
        .To = xEmailAddr
        .CC = ""
        .Subject = "Master Supplier Approval Questionnaire"
        .Body = "Dear all," & vbCr & vbCr & "Please find in attachment the Master Supplier Approval Questionnaire." & vbCr & vbCr & "Best regards,"
        .Attachments.Add PJ
        .Display
    End With
    Set xOutlook = Nothing
    Set xMailItem = Nothing
End Sub

Quelqu'un sait ce que je dois mettre à la place de pour fiixer les cellules dans lesquels je prends mes valeurs ?

    xTxt = ActiveWindow.RangeSelection.Address