Envoyer un fichier Excel en Pdf par mail

Version imprimable

Salut a tous

J'ai mon code :
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 Private Sub Sauver_Click() Dim a As Worksheet Dim sc As Workbook Dim nouveauNom As String Application.ScreenUpdating = False Set a = ActiveSheet nouveauNom = "DDE du " & Range("B40").Text & " " & Range("D40").Text & Range("E40").Text nouveauNom = Replace(nouveauNom, "/", "_") Set sc = Workbooks.Add(xlWBATWorksheet) sc.SaveAs (nouveauNom & ".xls") a.Copy Before:=sc.Sheets(1) ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator" Workbooks(nouveauNom & ".xls").Close SaveChanges:=False ' Kill nouveauNom & ".xls" Application.ScreenUpdating = True Application.DisplayAlerts = False Application.Quit Mail End Sub Private Sub Mail() Dim OlApp As Outlook.Application Dim OlItem As Outlook.MailItem 'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library" Set OlApp = New Outlook.Application Set OlItem = OlApp.CreateItem(olMailItem) With OlItem .To = "fcl31@msn.com" .Subject = nouveauNom .Body = nouveauNom .Attachments.Add "C:\Users\FCL31\Desktop\PDF\" & nouveauNom & ".pdf" .Categories = "Daily" .OriginatorDeliveryReportRequested = True .ReadReceiptRequested = True ' .Send End With Set OlItem = Nothing Set OlApp = Nothing End Sub
Cela me permet d'envoyer un fichier Excel en Pdf par mail avec le nom du fichier en fonction de différentes donnée de cellules (c'est le but en tout cas)

La première partie marche bien mais j'ai un problème sur la seconde :
Le fichier se cré bien en Pdf (dans l'endroit désigné dans "PdfCreator"), et s'enregistre en .xls (dans "Mes Documents")

Mais sa m'affiche une fenêtre d'erreur avec le message suivant :
Erreur d'exécution '-693698558 (d6a70002)'
et ne me propose pas de débogage.

J'ai constaté par contre que si je compare le fichier .xls et le fichier .pdf, j'ai un espace en plus avant le ".xls"
J'ai par exemple : DDE du 01_01_1900.pdf et DDE du 01_01_1900 .xls
Je pense que le problème viens de là mais je n'arrive pas à le résoudre

Merci de votre aide

23/03/2010, 13h48
JPierreM

Un rapide coup d'oeil avant de reprendre le boulot

La procèdure Mail doit être appelée avant l'instruction Application.Quit

Ensuite la variable nouveaunom est déclarée dans la procédure Sauver_Click, il faudrait la déclarer Public en tête de module pour pouvoir l'utiliser dans la seconde procédure

Suite a tes remarque, j'ai fait ca :

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
Private Sub Sauver_Click()
 
 
    Dim a As Worksheet
    Dim sc As Workbook
    Dim nouveauNom As String
    Dim OlApp As Outlook.Application
    Dim OlItem As Outlook.MailItem
 
    Set a = ActiveSheet
    Set OlApp = New Outlook.Application
    Set OlItem = OlApp.CreateItem(olMailItem)
 
    Application.ScreenUpdating = False
 
    nouveauNom = "DDE du " & Range("B40").Text & " " & Range("D40").Text & Range("E40").Text
    nouveauNom = Replace(nouveauNom, "/", "_")
    Set sc = Workbooks.Add(xlWBATWorksheet)
    sc.SaveAs (nouveauNom & ".xls")
    a.Copy Before:=sc.Sheets(1)
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    With OlItem
          .To = "fcl31@msn.com"
          .Subject = nouveauNom
          .Body = nouveauNom
          .Attachments.Add "C:\Users\FCL31\Desktop\PDF" & "\" & nouveauNom & ".pdf"
          .Categories = "Daily"
          .OriginatorDeliveryReportRequested = True
          .ReadReceiptRequested = True
          .Display 'Send '<<<<<<<<<<<<<<<TO SEND DIRECTLY
    End With
 
    Set OlItem = Nothing
    Set OlApp = Nothing
 
    Workbooks(nouveauNom & ".xls").Close SaveChanges:=False
    Kill nouveauNom & ".xls"
 
    Application.ScreenUpdating = True
 
    Application.DisplayAlerts = False
 
    Application.Quit
 
End Sub

Toutefois, j'ai toujours un probléme : sa plante ici :

Code:

.Attachments.Add "C:\Users\FCL31\Desktop\PDF" & "\" & nouveauNom & ".pdf"

Avant j'avais pas accé au débogage car j'avais laissé le mot de passe de protection VBA (je suis trop naze :oops:).

24/03/2010, 17h10
FCL31

Je me permet de revenir pour une petite précision :

J'ai testé ma macro en suppriment la ligne :

Code:

.Attachments.Add "C:\Users\FCL31\Desktop\PDF" & "\" & nouveauNom & ".pdf"

et sa marche nikel (sauf bien sur que j'ai pas pièces jointe)

Donc si je comprend bien, il n'arrive pas a trouver la pièce jointe (elle existe vraiment je vous rassure)

Mais je comprend pas pourquoi sa marche pas ??? :cry:

:koi:

PEUT IL Y AVOIR UN PROBLÈME SUR LE NOM DU FICHIER CRÉER EN PDF ?
OU AU NIVEAU DE PDFCREATOR ???

:koi: :koi: :koi:
25/03/2010, 15h44
JPierreM

Essaie de faire du pas à pas avec ta procédure pour voir si tu n'atteins pas la fin de la procédure avant l'enregistrement effectif du fichier en PDF.
En clair lorsque tu veux joindre la pièce jointe peut être n'est elle pas encore enregistrée
25/03/2010, 16h03
FCL31
Merci de ton aide

Mais quand j'exécute la macro pas à pas, pas de problème : tout marche nikel

Donc j'y comprend rien

Faut'il "marquer une pause" à un moment dans le code (si oui comment) ???
Comment faire ????

---------------------------------------------------------------------------------------------------
Edit
Je viens de tester en ajoutant une MsgBox après l'impression en Pdf donc :
Code:

1 2 3 4 5 6 7 8 9 ... ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator" MsgBox "Pdf fait" With OlItem .To = "fprieur@sagweb.com" .Subject = nouveauNom ...
Et sa marche

Y'a pas moyen d'éviter ca ??
25/03/2010, 16h29
FCL31
A y est j'ai réussi

Je sais pas si c'est la meilleure solution mais voici se que j'ai ajouté a ma macro :
Code:

1 2 3 4 5 6 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Sub Sauver_Click() ... Sleep 500 ...
Et sa marche mais je trouve ca un peut bizarre

Bref sa ferra l'affaire je pense

Merci a tous :ccool: