Envoi pdf par Outlook avec macro Excel

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

Malgré les nombreux messages traitant ce sujet, j'ai un problème avec la fonction.

Lorsque j'enregistre une macro, via l'enregistreur de macro Excel, cela fonctionne très bien (Fichier, Partager, sélection pdf).
Par contre lorsque je lance la macro il me joint le fichier Excel et non le pdf.
Ci-dessous le code généré par l'enregistreur de macro.
Code:

1 2 3 4 5 ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Users\esnfrbyx\AppData\Local\Temp\Quote Direction Sheet - Vx.pdf", Quality _ :=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False _ , OpenAfterPublish:=False Application.Dialogs(xlDialogSendMail).Show
Le pdf est bien créé dans le répertoire.
Je suis sous 365.
La librairie est bien active.

Quelqu'un a t'il une idée de mon problème ?

Merci d'avance.

Bonjour,

l'enregistreur de macro ne capture pas les séquence où c'est le pdf qui est attaché au mail.

Il faut donc traiter en deux étapes : la tienne (sans l'ouverture de la boite de dialogue d'envoi de mail) + une partie pour créer le mail et y attacher le pdf

par exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Toto()
 
' ton code de création du pdf
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\esnfrbyx\AppData\Local\Temp\Quote Direction Sheet - Vx.pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False _
, OpenAfterPublish:=False
 
 
' la partie qui crée le mail
With CreateObject("Outlook.Application")
    With .CreateItem(0)
        .To = "Adresse du destinataire"
        .Subject = "Sujet du mail"
        .attachments.Add "C:\Users\esnfrbyx\AppData\Local\Temp\Quote Direction Sheet - Vx.pdf"
        .display
    End With
End With
 
End Sub

14/09/2022, 12h58
hyperion13

Salut
La méthode que vous utilisez pour envoyer un mail permet d'envoyer en attache le classeur en cours.
14/09/2022, 13h33
Fredbyx

Envoi pdf + Outlook suite

Merci pour vos réponses.

J'ai déjà essayer de de dissocier la création du pdf et de l'envoi, mais à chaque fois j'ai un problème avec "CreateObject("Outlook.Application")".

J'ai une erreur d'exécution 429. Un composant ActiveX ne peut pas créer d'objet.

re,
Sans le code global ... :weird:
Un exemple de code fonctionnel

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub EnvoyerMail()
'early binding
'Microsoft Outkook xx.x Object Library
Dim xlWbk As Workbook
Dim xlWsh As Worksheet
Dim rngPlanning As Range
Dim strFilePath As String, strFolder As String, strPdfFile As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outAtt As Outlook.Attachment
 
Set xlWbk = ThisWorkbook
Set xlWsh = xlWbk.Worksheets("Mail")
Set rngPlanning = xlWsh.Range("D1:BF24")
 
strFilePath = ActiveWorkbook.Path & Application.PathSeparator
strFolder = "planning\"
strFilePath = strFilePath & strFolder
 
strPdfFile = Format(Now(), "yyyymmdd") & "_" & "Planning" & "_" & xlWsh.Range("BI6").Value & ".pdf"
 
rngPlanning.ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=strFilePath & strPdfFile, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
 
Debug.Print strFilePath & strPdfFile
Set outApp = New Outlook.Application
Set outMail = outApp.CreateItem(olMailItem)
 
With outMail
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Bonjour " & xlWsh.Range("BI6").Value & "<br>" & "<br>" & _
                "Vous trouverez votre planning en attache." & "<br>" & "<br>" & _
                "Bonne réception."
    .To = xlWsh.Range("BK5").Value
    .Subject = "Planning de la semaine n° " & xlWsh.Range("V3").Value
    .Attachments.Add strFilePath & strPdfFile
    .Display '.Send
End With
 
Set outMail = Nothing
Set outApp = Nothing
End Sub

La méthode d'hypérion, en early binding, nécessite de cocher la bonne référence Outlook, qui variera d'une version à l'autre.
Ce qui limite le portage d'une machine à l'autre.

Ton erreur provient vraisemblablement du fait que tu as déjà une instance outlook ouverte.

Il suffit donc de tester si on peut "capter" une instance Outlook, si ce n'est pas le cas, c'est qu'il est fermé ==> alors on l'ouvre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Toto()
Dim OlApp As Object
 
' ton code de création du pdf
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\esnfrbyx\AppData\Local\Temp\Quote Direction Sheet - Vx.pdf", Quality _
:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False _
, OpenAfterPublish:=False
 
' on tente de récupérer une instance Outlook ouverte
On Error Resume Next
    Set OlApp = GetObject(, "Outlook.Application")
On Error GoTo 0
 
' si on a rien récupéré, on en ouvre une
If OlApp Is Nothing Then Set OlApp = CreateObject("Outlook.Application")
 
' la partie qui crée le mail
With OlApp
    With .CreateItem(0)
        .To = "Adresse du destinataire"
        .Subject = "Sujet du mail"
        .attachments.Add "C:\Users\esnfrbyx\AppData\Local\Temp\Quote Direction Sheet - Vx.pdf"
        .display
    End With
End With
 
Set OlApp = Nothing
 
End Sub

14/09/2022, 17h00
Fredbyx

re,

Cela bloque toujours sur la même commande :roll:

Code:

Set OlApp = CreateObject("Outlook.Application")
14/09/2022, 17h05
joe.levrai

Tu as testé avec Outlook ouvert et également avec Outlook fermé ?

La proposition d'hyperion ne fonctionne pas non plus ? En Early Binding

L'erreur 429 peut avoir plusieurs origines.

Essaye de piocher par ici les autres causes possibles : https://support.microsoft.com/fr-fr/...5-aad6f37e68b6
14/09/2022, 17h11
Fredbyx

Oui j'ai testé avec Outlook ouvert et fermé, pareil.

J'ai également remis le code dans un nouveau fichier Excel afin de m'assurer que cela ne vient pas de mon fichier, pareil. Blocage au même endroit.

J'ai fait des tests avec le code de Hyperion13, pas plus de résultat, mais pas sûr d'avoir bien fais l'adaptation. J'ai pas eu beaucoup de temps.
14/09/2022, 17h22
Fredbyx

Autre info.

J'ai tester le code en remplaçant Outlook.Application par Excel.Application dans la ligne de code Set OlApp = CreateObject("outlook.Application").

Le programme n'a pas bloqué sur la ligne.

Il a bien sûr planté sur la partie qui crée le mail.
14/09/2022, 17h26
hyperion13

1 pièce(s) jointe(s)

re,
le code est bien fonctionnel.:weird:
14/09/2022, 17h33
Fredbyx

Merci Hyperion13,

Je ne doute pas le code fonctionne.
Je l'ai mis tel quel dans un autre fichier et il bloque dès la déclaration Dim outApp As Outlook.Application.

Je finis par penser qu'il s'agit d'un problème Outlook ou de droit.
14/09/2022, 17h39
Fredbyx

Je viens de me rendre compte que lorsque je clic droit sur un fichier sous l'explorateur et que je fait "envoyé vers" puis "destinataire", cela ne fonctionne pas. Outlook ne s'ouvre pas ??

Peut être que mon problème vient de par là, vous en pensez quoi ?

1 pièce(s) jointe(s)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub EnvoyerMail()
'late binding
Dim xlWbk As Workbook
Dim xlWsh As Worksheet
Dim rngPlanning As Range
Dim strFilePath As String, strFolder As String, strPdfFile As String
Dim objOut As Object
Dim objMail As Object
 
Set xlWbk = ThisWorkbook
Set xlWsh = xlWbk.Worksheets("Mail")
Set rngPlanning = xlWsh.Range("D1:BF24")
 
strFilePath = ActiveWorkbook.Path & Application.PathSeparator
strFolder = "planning\"
strFilePath = strFilePath & strFolder
 
strPdfFile = Format(Now(), "yyyymmdd") & "_latebinding_" & "Planning" & "_" & xlWsh.Range("BI6").Value & ".pdf"
 
rngPlanning.ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=strFilePath & strPdfFile, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
 
Set objOut = CreateObject("Outlook.Application")
Set objMail = objOut.CreateItem(olMailItem)
 
With objMail
    .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Bonjour " & xlWsh.Range("BI6").Value & "<br>" & "<br>" & _
                "Vous trouverez votre planning en attache." & "<br>" & "<br>" & _
                "Bonne réception."
    .To = xlWsh.Range("BK5").Value
    .Subject = "Planning de la semaine n° " & xlWsh.Range("V3").Value
    .Attachments.Add strFilePath & strPdfFile
    .Display '.Send
End With
End Sub

14/09/2022, 18h15
hyperion13

Mais Outlook est-il votre logiciel de messagerie par défaut sur Win?:weird:

Citation:

Envoyé par Fredbyx

Je viens de me rendre compte que lorsque je clic droit sur un fichier sous l'explorateur et que je fait "envoyé vers" puis "destinataire", cela ne fonctionne pas. Outlook ne s'ouvre pas ??

Peut être que mon problème vient de par là, vous en pensez quoi ?
14/09/2022, 18h51
Fredbyx

ça avance :)

Je viens d'adapter le code de Hyperion13 sur un autre PC et ça fonctionne.

Par contre, je ne sais pas encore pourquoi, sur le premier, ça bloque toujours sur Set objOut = CreateObject("Outlook.Application").
14/09/2022, 19h06
hyperion13

Et l'autre PC avec quel Office ? 365 ou autre ?
Possible d'avoir votre code intégral ?

Erreur429
CreateObject(“Outlook.Application”) ne fonctionne pas sur certains PC avec Office 365
Contournement Erreur429
14/09/2022, 19h14
Fredbyx

Le second est sous 2016.

Pas de problème pour mettre le code, mais il faut que je le remettre en forme.
J'essai de faire ça demain et je le mets sur le forum.

Sur les 2 pc, c'est bien Outlook.

Bonsoir,

Comme convenu , voilà le code dans son ensemble.
Par contre, je n'ai toujours pas trouvé pourquoi ça ne fonctionne pas sous 365 :roll:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub Pdf_mail()
'late binding
 
Dim xlWbk As Workbook
Dim xlWsh As Worksheet
Dim zonepdf As Range
Dim strFilePath As String, strFolder As String, strPdfFile As String
Dim objOut As Object
Dim objMail As Object
 
 
'Si cellule G2 contient un numéro => on ne passe pas par l'Inpubox de demande de répertoire
    If Cells(2, 7) <> "" Then
        Numéro_affaire = Cells(2, 7)
        GoTo Debut
    Else
        Numéro_affaire = InputBox("Quel est le numéro du répertoire de travail ?")
            Cells(2, 7) = Numéro_affaire
            If Numéro_affaire = "" Then
                MsgBox ("Veuillez saisir le numéro du répertoire de travail")
                Exit Sub
            End If
    End If
 
 
Debut:
 
Set xlWbk = ThisWorkbook
Set xlWsh = xlWbk.Worksheets("Feuil1")
Set zonepdf = xlWsh.Range("E1:K104")
 
strFilePath = ActiveWorkbook.Path & Application.PathSeparator
strFolder = "pdf\"
strFilePath = strFilePath & strFolder
 
strPdfFile = Format(Now(), "yyyy-mm-dd") & "-1#" & "-" & xlWsh.Range("G2").Value & "-I-QDS" & ".pdf"
 
zonepdf.ExportAsFixedFormat Type:=xlTypePDF, _
                                Filename:=strFilePath & strPdfFile, _
                                Quality:=xlQualityStandard, _
                                IncludeDocProperties:=True, _
                                IgnorePrintAreas:=False, _
                                OpenAfterPublish:=False
 
 
 
Set objOut = CreateObject("Outlook.Application")
Set objMail = objOut.CreateItem(olMailItem)
 
With objMail
   ' .BodyFormat = olFormatHTML
    .Display
    .HTMLBody = "Bonjour " & xlWsh.Range("J2").Value & "<br>" & "<br>" & _
                "Vous trouverez notre Quote Direction Sheet en attache." & "<br>" & "<br>" & _
                "Bonne réception."
    .To = xlWsh.Range("A2").Value
    .Subject = "Quote direction Sheet n° " & xlWsh.Range("G2").Value
    .Attachments.Add strFilePath & strPdfFile
    .Display '.Send
End With
 
End Sub

16/09/2022, 15h02
hyperion13

re,
A priori votre code semble OK.
Avez-vous lu ceci

Voir 40 message(s) de cette discussion en une page