Macro Excel : enregistrer feuille en PDF et envoi pièce jointe

Macro Excel : enregistrer feuille en PDF et envoi pièce jointe - VB/VBA/VBS - Programmation

Marsh Posté le 09-06-2007 à 09:19:03    

Et oui, encore moi avec mes macros.
Pour ma future activité, je crée une facture sous Excel. J'ai créé une macro qui permet d'enregistrer la facture dans un dossier portant le nom du client, le fichier étant automatiquement nommé avec la date et le numéro de facture. Voilà le code.

Code :
  1. Sub Enregistrement()
  2. Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$
  3. Chemin1 = "D:\Gestion\Factures\"
  4. Chemin2 = "H:\Zerobug backup\Factures\"
  5. Jour = Format(Day(Now()), "00" ) & Format(Month(Now()), "00" ) & Year(Now)
  6. Client = Range("G4" )
  7. Numfact = Range("H12" )
  8. Fichier = Jour & "_" & Numfact & ".xls"
  9. If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
  10. ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
  11. If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
  12. ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier
  13. End Sub


Maintenant, je cherche à ce que ma feuille soit automatiquement générée en PDF avec le même nom et, si possible, qu'un mail soit automatiquement ouvert avec le fichier au format PDF en pièce jointe.
Si quelqu'un peut m'aider......


Message édité par hyperion66 le 09-06-2007 à 09:22:02

---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 09-06-2007 à 09:19:03   

Reply

Marsh Posté le 09-06-2007 à 10:03:14    

bonjour deja,
quel logiciel de création de pdfas-tu sous la main ?

Reply

Marsh Posté le 09-06-2007 à 10:16:56    

Oups, trop pressé. Oui, bonjour !
J'utilise Adobe Acrobat 7


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 09-06-2007 à 11:34:13    

peut etre peux-tu simuler les touches de clavier pour enregistrer un document en pdf ?

Reply

Marsh Posté le 09-06-2007 à 12:20:08    

J'ai essayé, pas de touche clavier pour le pdf.


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 09-06-2007 à 13:26:01    

tu peux pas faire un systeme du genre :
shellexecute (adobe.exe)
sendkeys "N"
et la cinématique pour ouvrir le doc excel de départ etc ?

Reply

Marsh Posté le 09-06-2007 à 14:39:08    

Je n'en sais rien, je ne connais pas grand chose au VBA.


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 09-06-2007 à 18:19:06    

peux tu me donner la séquence de raccourcis clavier que tu utilises pour ouvrir un fichier, et l'enregistrer sous un format pdf.
ex :
Ctrl N pour fichier nouveau...

Reply

Marsh Posté le 09-06-2007 à 19:22:07    

Je n'utilise aucun raccourci clavier. Il n'y en a pas pour le PDF.


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 09-06-2007 à 21:55:24    

Utilise le macro recorder et l'imprimante virtuelle Acrobat Pdf  
puis optimise et adapte manuellement
sinon il faut aller voir sur http://www.rondebruin.nl/sendmail.htm
qui permet de joindre un feuille Xl en pj à un mail


Message édité par kiki29 le 09-06-2007 à 22:03:03
Reply

Marsh Posté le 09-06-2007 à 21:55:24   

Reply

Marsh Posté le 09-06-2007 à 22:07:38    

J'ai essayé avec le bouton recorder, ça ne marche pas !


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 09-06-2007 à 22:14:47    

Déjà avec le macro recorder et l'imprimante virtuelle Adobe pdf
tu devrais obtenir qqch comme


    Application.ActivePrinter = "Adobe PDF sur Ne03:"
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
        ActivePrinter:="Adobe PDF sur Ne03:", Collate:=True


 
puis ensuite  
Menu VBA Outils | Références : Cocher Microsoft CDO for Exchange xxxx Library


 
Sub tst()
Dim objMessage As CDO.Message
    Set objMessage = CreateObject("CDO.Message" )
    With objMessage
        .Subject = "Example CDO Message"
        .From = "x@x.fr"
        .To = "y@y.fr"
        .TextBody = "texte dans le corps de message"
        .AddAttachment "c:\tonfichier.pdf"
        .Send
    End With
End Sub


 
solution déjà donnée sur ce même forum !!


Message édité par kiki29 le 09-06-2007 à 22:40:52
Reply

Marsh Posté le 09-06-2007 à 22:55:12    

Au final


Option Explicit
 
 
' Menu VBA Outils | Références : Cocher Microsoft CDO for Exchange xxxx Library
Sub Tst()
Dim objMessage As CDO.Message
 
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
        ActivePrinter:="Adobe PDF sur Ne03:", Collate:=True
     
    If Application.Wait(Now + TimeValue("0:00:10" )) Then
        Set objMessage = CreateObject("CDO.Message" )
        With objMessage
            .Subject = "Example CDO Message"  
            .From = "x@x.fr"  
            .To = "y@y.fr"  
            .TextBody = "texte dans le corps de message"  
            .AddAttachment "c:\tonfichier.pdf"  
            .Send  
        End With
        Set objMessage =Nothing
    End If
End Sub


Message édité par kiki29 le 10-06-2007 à 03:43:11
Reply

Marsh Posté le 09-06-2007 à 23:23:03    

Effectivement, j'ai réessayé, j'obtiens ça :

Application.ActivePrinter = "Adobe PDF sur Ne03:"  
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _  
        ActivePrinter:="Adobe PDF sur Ne03:", Collate:=True


Mais il faudrait que le fichier soit automatiquement créé dans le bon dossier et le bon nom, comme pour le fichier xls.
 
Pour le moment, je voudrais déjà créer ça correctement (si c'est faisable) avant de m'attaquer à l'envoir par mail.
 
Merci


Message édité par hyperion66 le 09-06-2007 à 23:23:40

---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 10-06-2007 à 05:33:58    

un exemple qui utilise PDFCreator


'   http://sourceforge.net/projects/pdfcreator   PDFCreator-0_9_3_GPLGhostscript.exe
'   sous VBA Menu Outils | Références  Cocher PDFCreator
'   sous VBA Menu Outils | Références  Cocher Microsoft CDO for Exchange xxxx Library
 
Sub Tst_PdfCreator()
Dim objMessage As CDO.Message
Dim jobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
 
    sNomPDF = "Essai.pdf"
    sCheminPDF = ActiveWorkbook.Path & Application.PathSeparator
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    Set jobPDF = CreateObject("PDFCreator.clsPDFCreator" )
 
    With jobPDF
        If .cStart("/NoProcessingAtStartup" ) = False Then
            MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave" ) = 1
        .cOption("UseAutosaveDirectory" ) = 1
        .cOption("AutosaveDirectory" ) = sCheminPDF
        .cOption("AutosaveFilename" ) = sNomPDF
 
        '0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
        .cOption("AutosaveFormat" ) = 0    
        .cClearCache
    End With
 
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    'Fichier dans la file d'attente
    Do Until jobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    jobPDF.cPrinterStop = False
 
    'Attendre que la file d'attente soit vide
    Do Until jobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
    jobPDF.cClose
    Set jobPDF = Nothing
     
    Set objMessage = CreateObject("CDO.Message" )
    With objMessage
        .Subject = "Essai"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@wanadoo.fr"
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sCheminPDF & sNomPDF
        .Send
    End With
     
    Set objMessage = Nothing
End Sub


Message édité par kiki29 le 10-06-2007 à 08:29:42
Reply

Marsh Posté le 10-06-2007 à 19:10:58    

Bon, ça progresse doucement, mais toujours pas au point.
 
Voilà la dernière version de ma macro :

Sub Enregistrement()
Dim Chemin1$, Chemin2$, Client$, Fichier$, Numfact$, Jour$, F$, N$
Chemin1 = "H:\Zerobug backup\Factures\"
Chemin2 = "D:\Gestion\Factures\"
Jour = Format(Now(), "ddmmyyyy" )
Client = Range("H7" )
Numfact = Range("I15" )
Fichier = Jour & "_" & Numfact & ".xls"
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
If Dir(Chemin2 & Client, 16) = "" Then MkDir Chemin2 & Client
ActiveWorkbook.SaveAs Chemin2 & Client & "\" & Fichier
N = Jour & "_" & Numfact
F = Application.GetSaveAsFilename(N, "fichier pdf,*.pdf" )
    Application.ActivePrinter = "Adobe PDF sur Ne03:"
    SendKeys N & "{ENTER}", False
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
                                         "Adobe PDF sur Ne03:"
  End Sub


Donc, ça m'enregistre bien mon fichier XLS avec le bon nom et dans le bon dossier (nom et prénom du client qui fait référence à la cellule H7), ça me lance ensuite "l'impression" PDF via l'imprimante Acrobat, avec là aussi le bon nom. Mais je dois sélectionner le dossier de destination, et même en sélectionnant le bon dossier de destination, il l'enregistre dans C:\Mes Documents (qui fait référence au port de l'imprimante PDF). Vous me direz bien que le plus simple serait de modifier le port de l'imprimante, mais vu que chaque PDF est enregistré dans un dossier différent, ça ne me convient pas.
Je rappelle que j'utilise Acrobat 7.
 
Merci à l'âme charitable qui pourrait venir me donner un coup de main.


Message édité par hyperion66 le 10-06-2007 à 19:15:36

---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 10-06-2007 à 20:36:43    

Moi aussi j'ai Acrobat mais si je t'ai donné une version avec PDFCreator c'est que cela était possible et ce n'est pas faute d'avoir cherché sur Adobe.


Message édité par kiki29 le 11-06-2007 à 03:15:15
Reply

Marsh Posté le 11-06-2007 à 03:17:10    

A toi de l'adapter, en fait il fallait passer par Distiller


Private GenererPDFDistiller()
Dim CdoMessage As CDO.Message
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
Dim PDFDist As PdfDistiller
 
    sNomFichierPS = ThisWorkbook.Path & "\Essai_Distill.ps"
    sNomFichierPDF = ThisWorkbook.Path & "\Essai_Distill.pdf"
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    ActiveSheet.PrintOut copies:=1, Preview:=False, _
        ActivePrinter:="Acrobat Distiller", PrintToFile:=True, _
        Collate:=True, PrToFileName:=sNomFichierPS
         
    Set PDFDist = New PdfDistiller
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
         
    Set CdoMessage = New CDO.Message
    With CdoMessage  
        .Subject = "Exemple Distiller"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@wanadoo.fr"
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sNomFichierPDF
        .Send
    End With
     
    Kill sNomFichierPS
    Kill ThisWorkbook.Path & "\Essai_Distill.log"
 
    Set CdoMessage = Nothing
    Set PDFDist = Nothing
End Sub


Message édité par kiki29 le 11-06-2007 à 07:06:24
Reply

Marsh Posté le 11-06-2007 à 05:10:05    

Pour la création correcte de tes dossiers et sous dossiers
 


....
    If CreationDossiers(Chemin1 & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin1 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs  .....
    End If
....


 
ici une fonction de création des dossiers et sous dossiers
 


Private Function CreationDossiers(ByVal Chemin As String) As Boolean
Dim i As Long
Dim sTmp As String
Dim Ar() As String
 
    If InStr(1, Chemin, ":" ) = 0 Then
        Ar = Split(CurDir & Chemin, "\" )
    Else
        Ar = Split(Chemin, "\" )
    End If
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(Chemin, vbDirectory) = "" Then
        On Error Resume Next
        RmDir Ar(0) & "\" & Ar(1)
        On Error GoTo 0
    Else
        CreationDossiers = True
    End If
End Function


 
Il ne te reste plus qu'a faire ta cuisine en modifiant Sub GenererPDFDistiller pour lui passer le chemin et nom de fichier en parametres GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)


Message édité par kiki29 le 11-06-2007 à 07:02:27
Reply

Marsh Posté le 11-06-2007 à 08:22:31    

Houla, je crois que ça deviens trop compliqué pour moi tout ça !
Surtout dans le second code, où est-ce que je rentre le sous-dossiers "Année" ?
Et puis elle y est l'imprimante Distiller avec Acrobat 7 ? En tous cas, elle n'apparaît pas avec ma liste d'imprimantes.
 
En tous cas, merci pour ton aide.


Message édité par hyperion66 le 11-06-2007 à 08:25:04

---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 08:37:10    

Réalisé sur la gaz à partir de ton code


 
'    VBA Menu Outils | Références COCHER Acrobat Distiller  
'                                 COCHER Microsoft CDO Exchange xxxx Library
 
Option Explicit
 
Sub Enregistrement()
Dim Chemin1 As String, Chemin2 As String
Dim Client As String
Dim Fichier As String
Dim Numfact As String
Dim Jour As String
Dim sNomFichier As String
 
    Chemin1 = "C:\Transfert\EssaisPdf\Factures"
    Chemin2 = "D:\Transfert\EssaisPdf\Factures"
 
    Jour = Format(Now(), "ddmmyyyy" )
    Client = Range("H7" )
    Numfact = Range("I15" )
 
    If Len(Client) = 0 Then
        MsgBox "Cellule Client vide", vbOKOnly
        Exit Sub
    End If
    If Len(Numfact) = 0 Then
        MsgBox "Cellule N° Facture incorrecte", vbOKOnly
        Exit Sub
    End If
 
    Fichier = Jour & "_" & Numfact & ".xls"
 
    If CreationDossiers(Chemin1 & "\" & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin1 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs Chemin1 & "\" & Client & "\" & Fichier
    End If
 
    If CreationDossiers(Chemin2 & "\" & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin2 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs Chemin2 & "\" & Client & "\" & Fichier
    End If
     
    sNomFichier = Jour & "_" & Numfact
     
    GenererPDFDistiller Chemin1, sNomFichier
End Sub
 
Sub GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)
Dim CdoMessage As CDO.Message
Dim PDFDist As PDFDistiller
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
 
    sNomFichierPS = Chemin & "\" & NomDuFichier & ".ps"
    sNomFichierPDF = Chemin & "\" & NomDuFichier & ".pdf"
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    ActiveSheet.PrintOut copies:=1, Preview:=False, _
        ActivePrinter:="Acrobat Distiller", PrintToFile:=True, _
        Collate:=True, PrToFileName:=sNomFichierPS
         
    Set PDFDist = New PDFDistiller
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
         
    Set CdoMessage = New CDO.Message
    With CdoMessage
        .Subject = "Exemple"
        .From = "xxxxx@wanadoo.fr"
        .To = "yyyyy@wanadoo.fr"
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sNomFichierPDF
        .Send
    End With
     
    Kill sNomFichierPS
    Kill sNomFichierPDF
    Kill Chemin & "\" & NomDuFichier & ".log"
     
    Set PDFDist = Nothing
    Set CdoMessage = Nothing
End Sub
 
Private Function CreationDossiers(ByVal Chemin As String) As Boolean
Dim i As Long
Dim sTmp As String
Dim Ar() As String
 
    If InStr(1, Chemin, ":" ) = 0 Then
        Ar = Split(CurDir & Chemin, "\" )
    Else
        Ar = Split(Chemin, "\" )
    End If
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(Chemin, vbDirectory) = "" Then
        On Error Resume Next
        RmDir Ar(0) & "\" & Ar(1)
        On Error GoTo 0
    Else
        CreationDossiers = True
    End If
End Function


Message édité par kiki29 le 11-06-2007 à 10:55:18
Reply

Marsh Posté le 11-06-2007 à 08:46:17    

Une erreur se produit ici :

Sub GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)
Dim CdoMessage As CDO.Message


 
Par contre, à quoi sert l'option Explicit ?


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 09:46:59    

Il ne faut pas oublier :
VBA Menu Outils | Références COCHER Acrobat Distiller
                                                    Microsoft CDO Exchange xxxx Library
 
Explicit [F1] => Aide en ligne


Message édité par kiki29 le 11-06-2007 à 09:49:40
Reply

Marsh Posté le 11-06-2007 à 10:39:08    

Il me met une erreur "Cellule N° Facture incorrecte". Je pense que cela vient du fait que tu as mis dans le code :

If Len(Numfact) = 0 Or Not (IsNumeric(Numfact)) Then


Or, le numéro de facture est de type ROBE31976 par exemple !
Comment corriger cette ligne ?


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 10:40:44    

si ton nombre de caracteres reste fixe avec ROBE ou quoi que ce soit en 4 caractere puis un nombre, utilise la fonction mid() [F1]

Reply

Marsh Posté le 11-06-2007 à 10:44:02    

Correction du code effectuée en supprimant Or Not (IsNumeric(Numfact))


Message édité par kiki29 le 11-06-2007 à 10:48:53
Reply

Marsh Posté le 11-06-2007 à 10:59:10    

Erreur :

Dim CdoMessage As CDO.Message


Je ne trouve pas Microsoft CDO Exchange xxxx Library


Message édité par hyperion66 le 11-06-2007 à 11:09:45

---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 11:31:09    

Bon, merci pour votre aide, ça avance.....
 
Chez moi, ça ne s'appelle pas Microsoft CDO Exchange xxxx Library mais Microsoft CDO for Windows 2000 Library
 
Voilà où en est le code :


'    VBA Menu Outils | Références COCHER Acrobat Distiller
'                                 COCHER Microsoft CDO Exchange xxxx Library
 
Option Explicit
 
Sub Enregistrement()
Dim Chemin1 As String, Chemin2 As String
Dim Client As String
Dim Fichier As String
Dim Numfact As String
Dim Jour As String
Dim sNomFichier As String
 
    Chemin1 = "D:\Gestion\Factures"
    Chemin2 = "H:\Zerobug backup\Factures"
 
    Jour = Format(Range("H13" ), "ddmmyyyy" )
    Client = Range("H7" )
    Numfact = Range("I15" )
 
    If Len(Client) = 0 Then
        MsgBox "Cellule Client vide", vbOKOnly
        Exit Sub
    End If
    If Len(Numfact) = 0 Then
        MsgBox "Cellule N° Facture incorrecte", vbOKOnly
        Exit Sub
    End If
 
    Fichier = Jour & "_" & Numfact & ".xls"
 
    If CreationDossiers(Chemin1 & "\" & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin1 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs Chemin1 & "\" & Client & "\" & Fichier
    End If
 
    If CreationDossiers(Chemin2 & "\" & Client) = False Then
        MsgBox "Création dossier impossible" & vbCrLf & Chemin2 & Client, vbOKOnly
        Exit Sub
    Else
        ActiveWorkbook.SaveAs Chemin2 & "\" & Client & "\" & Fichier
    End If
     
    sNomFichier = Jour & "_" & Numfact
     
    GenererPDFDistiller Chemin1, sNomFichier
End Sub
 
Sub GenererPDFDistiller(ByVal Chemin As String, ByVal NomDuFichier As String)
Dim CdoMessage As CDO.Message
Dim PDFDist As PDFDistiller
Dim sNomFichierPS As String
Dim sNomFichierPDF As String
 
    sNomFichierPS = Chemin & "\" & NomDuFichier & ".ps"
    sNomFichierPDF = Chemin & "\" & NomDuFichier & ".pdf"
 
    If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
 
    ActiveSheet.PrintOut copies:=1, Preview:=False, _
        ActivePrinter:="Acrobat Distiller", PrintToFile:=True, _
        Collate:=True, PrToFileName:=sNomFichierPS
         
    Set PDFDist = New PDFDistiller
    PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
         
    Set CdoMessage = New CDO.Message
    With CdoMessage
        .Subject = "Votre facture"
        .From = "contact@zerobug.fr"
        .To = Range("G10" )
        .TextBody = "Texte dans le corps de message"
        .AddAttachment sNomFichierPDF
        .Send
    End With
     
    Kill sNomFichierPS
    Kill sNomFichierPDF
    Kill Chemin & "\" & NomDuFichier & ".log"
     
    Set PDFDist = Nothing
    Set CdoMessage = Nothing
End Sub
 
Private Function CreationDossiers(ByVal Chemin As String) As Boolean
Dim i As Long
Dim sTmp As String
Dim Ar() As String
 
    If InStr(1, Chemin, ":" ) = 0 Then
        Ar = Split(CurDir & Chemin, "\" )
    Else
        Ar = Split(Chemin, "\" )
    End If
 
    sTmp = Ar(0)
    For i = LBound(Ar) + 1 To UBound(Ar)
        If Ar(i) <> "" Then
            sTmp = sTmp & "\" & Ar(i)
            On Error Resume Next
            MkDir sTmp
            On Error GoTo 0
        End If
    Next
 
    If Dir(Chemin, vbDirectory) = "" Then
        On Error Resume Next
        RmDir Ar(0) & "\" & Ar(1)
        On Error GoTo 0
    Else
        CreationDossiers = True
    End If
End Function


 
Avec tout ça, il me génère bien .ps et .log dans le dossier Factures, mais il ne génère pas le .pdf !! D'où une erreur lors de la création du mail. Il ne manque pas une ligne pour transformer le PS en PDF ?


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 11:36:57    

Il faut être loggé en administrateur

Reply

Marsh Posté le 11-06-2007 à 11:50:22    

Je suis loggué en admin.


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 11:55:46    

Ici je n'ai strictement aucun problemes , Quelle message d'erreur as-tu ?
il faut passer en mode pas à pas et déterminer ( si possible ) l'endroit qui amene cette erreur
 
Quand tu double clique sur le fichier PS cela doit lancer Acrobat Distiller et générer le PDF ?
Ici c'est le cas


Message édité par kiki29 le 11-06-2007 à 12:15:34
Reply

Marsh Posté le 11-06-2007 à 12:20:01    

Erreur d'exécution '-2147024894 (80070002)' :
Le fichier spécifié est introuvable
 
Si je clique sur déboguage, il m'envoit sur cette ligne :

       .AddAttachment sNomFichierPDF


 
Dans le dossier Factures, j'ai bien le .log et le .ps mais aucun .pdf !


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 12:22:24    

Je viens de voir le log de disitiller :
 
%%[ Flushing: rest of job (to end-of-file) will be ignored ]%%
%%[ Warning: PostScript error. No PDF file produced. ] %%
Durée de conversion : 0 secondes (00:00:00)
**** Fin du travail ****


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 12:26:20    

Ici le même log produit :
 
%%[ ProductName: Distiller ]%%
%%[ Warning: Helvetica not found, using Font Substitution. Font cannot be embedded.]%%
%%[ Warning: Helvetica-Bold not found, using Font Substitution. Font cannot be embedded.]%%
%%[Page: 1]%%
%%[LastPage]%%
 
Peut être un paramétrage de Distiller ? ou de timing ?


If Application.Wait(Now + TimeValue("00:00:10" )) Then
    Set CdoMessage = New CDO.Message  
    With CdoMessage  
        .Subject = "Votre facture"  
        .From = "contact@zerobug.fr"  
        .To = Range("G10" )  
        .TextBody = "Texte dans le corps de message"  
        .AddAttachment sNomFichierPDF  
        .Send  
    End With  
End If


Message édité par kiki29 le 11-06-2007 à 12:37:06
Reply

Marsh Posté le 11-06-2007 à 12:48:09    

Toujours pas de création du PDF.
Y'a moyen que je te fasse passer mon doc Excel par mail pour qur tu y jettes un oeil ?


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 12:54:48    

si a phmdùfldsùmflmùdslfùmdslfmùls


Message édité par kiki29 le 11-06-2007 à 13:38:04
Reply

Marsh Posté le 11-06-2007 à 13:38:34    

Ici tout se passe sans probleme

Reply

Marsh Posté le 11-06-2007 à 13:52:50    

Zut, je ne vois pas pourquoi ça déconne chez moi. Tu as quelle version d'Acrobat ?
Tu as utilisé mon fichier sans rien modifier ?


Message édité par hyperion66 le 11-06-2007 à 13:53:15

---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le 11-06-2007 à 14:04:35    

Acrobat 6.0.6
les seules choses changées sont le chemin des fichiers
Supprimer la boucle d'attente
la ref CDO elle passe à 2000 chez moi
 
AdobePdfMakerForOffice est absent chez moi , je le décocherai chez toi pour voir


Message édité par kiki29 le 12-06-2007 à 02:57:29
Reply

Marsh Posté le 11-06-2007 à 14:06:42    

Tu as donc bien Microsoft CDO for Windows 2000 Library  ?


---------------
MATOS VELO - Club Strava Matos Vélo
Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed