Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe

Nosma

XLDnaute Nouveau
Bonjour à tous,
comment vous allez?
je suis en train de finaliser un fichier, je suis vraiment de mon petit projet. c'est fichier pour un service comptable avec plusieurs décompte sur plusieurs feuille.
je veux creer une macro, grace un click ou un bouton met la feuille en pdf et ensuite l'insert en pièce jointe sur outlook.
j'ai tourner ma macro dans tous les sens, elle bloque toujours au meme point. (en rouge)
quelqu'un aurai une solution? please.


Dim repertoire, fichier As String
Dim OutApp As Object
Dim OutMail As Object

Sheets("Decompte Acquéreur").Select
Range("B1: E60").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\manos\Desktop\DECOMPTE ACQUEREUR_" & Format(Now(), "dd.mm.yyyy"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.Cc = ""
.Attachments.Add (repertoire & "\" & fichier)
.Subject = "DECOMPTE ACQUEREUR"
.Body = "Bonjour, Veuillez trouver en pièce jointe le fichier PDF du décompte acquéreur."
.Display
End With
 

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD

Bonjour, une idée qui fonctionne pour moi, à adapter

VB:
    fichier = "E:\Comptabilite\Data\Facture Acompte\" & ListBox3.Value & ""
    With oBjMail
        .Display
        .To = mail_t ' le destinataire
        '.CC = ""
        '.BCC = ""
        .Subject = "Facture d'acompte"
        .HTMLBody = strbody & " " & .HTMLBody
        .Attachments.Add fichier
        .Display
        '.Send
    End With

Bonne soirée
 

TooFatBoy

XLDnaute Barbatruc
Bonjour,

j'ai tourner ma macro dans tous les sens, elle bloque toujours au meme point. (en rouge)
quelqu'un aurai une solution? please.
1- Tu as oublié d'affecter une valeur à repertoire et aussi à fichier.
2- Tu as oublié d'ajouter ".pdf" au nom du fichier à attacher au mail.

Une proposition
VB:
Sub EnvoiMail()
'
Dim repertoire, fichier As String
Dim OutApp As Object, OutMail As Object

    repertoire = "C:\Users\manos\Desktop"
    fichier = "DECOMPTE ACQUEREUR_" & Format(Now(), "dd.mm.yyyy")

    Sheets("Decompte Acquéreur").Range("B1: E60"). _
            ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=repertoire & "\" & fichier, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False

    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = ""
        .Cc = ""
        .Attachments.Add (repertoire & "\" & fichier & ".pdf")
        .Subject = "DECOMPTE ACQUEREUR"
        .Body = "Bonjour, Veuillez trouver en pièce jointe le fichier PDF du décompte acquéreur."
        .Display
    End With

End Sub
 

Phil69970

XLDnaute Barbatruc
Bonjour à tous

@Nosma :

Je te propose ce code :

VB:
Option Explicit

Sub PDF_Mail()

Dim Ws As Worksheet, Chemin$, NFichier$
Dim OutApp As Object, OutMail As Object

Set Ws = Worksheets("Decompte Acquéreur")

Chemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
NFichier = "DECOMPTE ACQUEREUR_" & Format(Date, "dd.mm.yyyy")

'*********** PDF
Ws.PageSetup.PrintArea = ("$B$1: $E$60")
Ws.ExportAsFixedFormat xlTypePDF, Chemin & NFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True
NFichier = Chemin & NFichier & ".PDF"
'***********

'*********** Envoie le Mail
'On Error Resume Next ' Si pb
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = ""  ' A remplir !!!
    .CC = ""  ' A remplir !!!
    .Subject = "DECOMPTE ACQUEREUR"
    .Body = "Bonjour, Veuillez trouver en pièce jointe le fichier PDF du décompte acquéreur."
    .Attachments.Add NFichier
    .Display    ' Visualisation fichier
'    '.Send      ' Envoi fichier à activer pour l'envoi
End With
'***********
Set Ws = Nothing: Set OutApp = Nothing: Set OutMail = Nothing
End Sub

Merci de ton retour
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…