Envoi en PDF un fichier Excel

Question

Bonsoir,

J'ai recopié une macro sur ce forum, mais le pièce jointe ne vient pas.

Qu'est-ce que j'ai fait de faux ?

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

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

Set Sourcewb = ActiveWorkbook

'Copie la feuille active comme nouvelle feuille

ActiveSheet.Copy
Set destwb = ActiveWorkbook

'Désactiver fenêtre de compatibilité
        Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------

LaDate = Format(Range("A1"), "yymmdd") 'formatage de la date
Nom = "réserves bus"  'Nom de l'onglet à entregistrer
Chemin = "C:\Dossier en transfert/"

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With destwb
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Chemin & LaDate & "_" & Nom & ".pdf", Quality:= _
  xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False  'enregistrement du fichier en PDF

    On Error Resume Next
    With OutMail
        .To = "prénom.nom@abc.com"
    .Subject = "Attribution des réserves - " & Range("A1")
    .SentOnBehalfOfName = "<ZWX@abc.com>"
    .Body = "Bonjour," & vbCrLf & "Vous trouverez en pièce jointe l'attribution des réserves du jour " & vbCrLf & "" & vbCrLf & "Meilleures salutations" & vbCrLf & "XYZ"
    .display 'ou alors utiliser

    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

    'Effacer le fichier envoyé
Kill Chemin & LaDate & "_" & Nom & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing

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

End Sub

Merci d'avance

Invité · Accepted Answer

Déjà il y a un problème avec le chemin Chemin = "C:\Dossier en transfert/" à la fin ce doit être un antislash...

Ergotamine · Accepted Answer

C'est étrange tu n'as pas de .attachement dans ton outmail qui se réfère à ton PDF. A creuser si tu veux comprendre, sinon reviens vers nous. Bonne soirée ! Edit : Bonjour Bruno45, merci ...

Invité · Accepted Answer

Re,

C'est certain aucune ligne pour attacher le fichier, voici le code optimisé à tester

Sub Mail()
  Dim DestWb As Workbook
  Dim OutApp As Object, OutMail As Object
  Dim Chemin As String, LaDate As String, sNom As String, sPathFile As String

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  'Copie la feuille active comme nouvelle feuille
  ThisWorkbook.ActiveSheet.Copy
  Set DestWb = ActiveWorkbook
  'Désactiver fenêtre de compatibilité
  Application.DisplayAlerts = False
  '----------------------------------------------------------------------------
  'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
  '----------------------------------------------------------------------------
  LaDate = Format(Range("A1"), "yymmdd") 'formatage de la date
  sNom = "réserves bus"  'Nom de l'onglet à entregistrer
  Chemin = "C:\Dossier en transfert\"
  ' Définir le chemin et le nom du fichier
  sPathFile = Chemin & LaDate & "_" & sNom & ".pdf"
  ' Exporter la feuille
  DestWb.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPathFile, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False  'enregistrement du fichier en PDF
  ' Créer une instance Outlook et mail
  Set OutApp = CreateObject("outlook.application")
  Set OutMail = OutApp.CreateItem(0)
  With OutMail
    .display  ' Afficher le mail vide pour avoir la signature
    .To = "prénom.nom@abc.com"
    .Subject = "Attribution des réserves - " & Range("A1")
    .SentOnBehalfOfName = "<ZWX@abc.com>"
    .Body = "Bonjour," & vbCrLf & "Vous trouverez en pièce jointe l'attribution des réserves du jour " & vbCrLf & "" & vbCrLf & "Meilleures salutations" & vbCrLf & "XYZ"
    ' Attacher le fichier au mail
    .Attachments.Add sPathFile
  End With
  DestWb.Close savechanges:=False
  'Effacer le fichier envoyé
  Kill sPathFile
  '
  Set OutMail = Nothing
  Set OutApp = Nothing

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

@+