Bonjour,
je débute totalement en VBA donc désolé si mes questions sont idiotes.
J'ai réussi (miraculeusement) a faire fonctionner le code indiqué ci-dessus dans mon outlook 2010.

Donc: je selectionne les emails contenant un fichier PDF, les fichiers se déposent dans C:\temp puis s'impriment automatiquement sur l'imprimante par défaut.

Mon problème:
mes PDF sont en couleur et je souhaite les imprimer en couleur sur une autre imprimante qui n'est pas celle par défaut, et je ne sais pas si c'est important mais elle est en réseau. dans l'image ci dessous c'est la HP color CP1515.



Voici ma macro qui fonctionne donc sur l'imprimante par défaut:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
'en tête de module
'ceci est un code de GEO
 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpszOp As String, _
    ByVal lpszFile As String, ByVal lpszParams As String, _
    ByVal lpszDir As String, ByVal fsShowCmd As Long) As Long
 
'la macro
Sub printPDF(chems)
Dim Res As Long
Dim chemin_de_MaPj As String
'chemin_de_MaPj = "c:\temp\test.pdf"
chemin_de_MaPj = chems
Res = ShellExecute(0, "print", chemin_de_MaPj, "", "", 0)
End Sub
 
 
 
Sub ImprimePDFdeTouteLaSelection()
'---------------------------------------------------------------------------------------
' Procedure : ImprimePDFdeTouteLaSelection
' Author    : Oliv'
' Date      : 26/11/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
 
    Dim MonOutlook As Outlook.Application
    Dim Mail As Object
    Dim LeMail As Outlook.MailItem
    Dim LesMails As Object
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
 
 
            Dim pj As Attachment
            For Each pj In LeMail.Attachments
                If Right(UCase(pj.FileName), 4) = ".PDF" Then
                    LeFichier = "c:\temp\" & pj.FileName
                    pj.SaveAsFile (LeFichier)
                    'là tu mets ta fonction pour imprimer
                    Call printPDF(LeFichier)
 
                   DoEvents
                    Kill LeFichier
                    'supprime le fichier
                End If
            Next pj
 
    Next LeMail
    Set LesMails = Nothing
    MsgBox "Opération terminée"
End Sub
Quelqu'un pourrait me dire ce que je dois ajouter pour selectionner cette imprimante "HP color CP1515" afin que l'impression se fasse sur cette imprimante ?

En vous remerciant par avance.

Edit:
j'ai lu ici : http://www.developpez.net/forums/d65...e-outlook-pdf/
que Outlook ne permet d'imprimer que sur l'imprimante par défaut.
Ca m'inquiete un peu...n'y aurait il pas moyen depuis la macro de changer l'imprimante par defaut puis de la remettre à la fin ?

aah zut j'ai un probleme, la macro supprime le fichier avant qu'il soit imprimé avant ca marchait car j'avais commenté le "kill LeFichier" donc je ne m'etais pas rendu compte du problème

Bon, il me semble que c'est un problème de timing, le DoEvents n'a pas l'air de bien fonctionner, du coup la macro essaie de supprimer avant meme que l'impression ai démarrer. je suis obligé de mettre un SLEEP (sans faire de jeu de mot ).

Concernant le changement d'imprimante j'ai trouvé comment faire !

il suffit de passer par un batch:
http://www.robvanderwoude.com/2kprintcontrol.php

voici ma macro qui marche à 100%:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpszOp As String, _
    ByVal lpszFile As String, ByVal lpszParams As String, _
    ByVal lpszDir As String, ByVal fsShowCmd As Long) As Long
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
 
'la macro d'impression, chems= chemin complet de la piece jointe
Sub printPDF(chems)
Dim Res As Long
Dim chemin_de_MaPj As String
chemin_de_MaPj = chems
Res = ShellExecute(0, "print", chemin_de_MaPj, "", "", 0)
End Sub
 
 
 
Sub ImprimePDFdeTouteLaSelection()
'---------------------------------------------------------------------------------------
' Procedure : ImprimePDFdeTouteLaSelection
'---------------------------------------------------------------------------------------
 
' On met l'imprimante couleur par defaut
Shell "C:\temp\color_printer.bat", 0
Sleep 1000
    Dim MonOutlook As Outlook.Application
    Dim Mail As Object
    Dim LeMail As Outlook.MailItem
    Dim LesMails As Object
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
 
 
            Dim pj As Attachment
            For Each pj In LeMail.Attachments
                If Right(UCase(pj.FileName), 4) = ".PDF" Then
                    LeFichier = "c:\temp\" & pj.FileName
                    pj.SaveAsFile (LeFichier)
                    'ci-dessous on lance l'impression
                    printPDF (LeFichier)
 
                   DoEvents
                   Sleep 1000
                    ' On supprime le fichier imprimé
                    Kill LeFichier
                End If
            Next pj
 
    Next LeMail
    Set LesMails = Nothing
    MsgBox "Opération terminée, cliquez sur OK pour remettre l'imprimante par defaut"
    Shell "C:\temp\default_printer.bat", 0
End Sub
Dans cette macro il vous faudra peut être adapter le "Sleep 1000" a votre configuration si elle est plus ou moins rapide. en cas d'erreur il suffit d'augmenter la valeur, 1000 = 1 seconde, donc pour attendre 2 seconde on fait un "Sleep 2000". Pour moi 1000 laisse le temps au systeme d'imprimer le fichier avant de le supprimer. sur un autre PC de ma société il a fallu mettre 2000 pour ne pas avoir d'erreur.

j'ai donc fait 2 Batchs:
1 pour mettre l'imprimante couleur par defaut : color_printer.bat
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
:: Met par défaut l'imprimante hpcolorcp1515
RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n \\94.0.0.6\hpcolorcp1515
1 pour remettre l'impriamnte N&B par defaut: default_printer.bat
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
:: Met par défaut l'imprimante info-kyofax
RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n \\94.0.0.6\info-kyofax
Voilà, c'est peut etre pas la meilleure méthode, mais en tout cas ca marche

Si vous voyez des optimisations ou améliorations possibles, elles seront les bienvenues

Bon chui chaud là !!!

La version précédente, detache et imprime les fichiers 1 par 1. Voici une adaptation qui sera certainement plus rapide car elle détache d'abord toutes les pièces jointes, puis les imprime toutes ensuite.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
 Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpszOp As String, _
    ByVal lpszFile As String, ByVal lpszParams As String, _
    ByVal lpszDir As String, ByVal fsShowCmd As Long) As Long
 
'la macro d'impression, chems= chemin complet de la piece jointe
Sub printPDF(chems)
    Dim Res As Long
    Dim chemin_de_MaPj As String
    chemin_de_MaPj = chems
    Res = ShellExecute(0, "print", chemin_de_MaPj, "", "", 0)
End Sub
 
Sub PrintAllPDF()
 
    Dim strFileName As String
    Dim strPath As String
 
    strPath = "c:\temp\"
    strFileName = Dir(strPath + "*.pdf", vbNormal)
    Do While strFileName <> ""
 
        LeFichier = strPath + strFileName
        printPDF (LeFichier)
        strFileName = Dir
    Loop
 
End Sub
 
Sub detache_PJ()
    Dim MonOutlook As Outlook.Application
    Dim Mail As Object
    Dim LeMail As Outlook.MailItem
    Dim LesMails As Object
    Set MonOutlook = Outlook.Application
    Set LesMails = MonOutlook.ActiveExplorer.Selection
    For Each LeMail In LesMails
             Dim pj As Attachment
            For Each pj In LeMail.Attachments
                If Right(UCase(pj.FileName), 4) = ".PDF" Then
                    LeFichier = "c:\temp\" & pj.FileName
                    pj.SaveAsFile (LeFichier)
 
                End If
            Next pj
    Next LeMail
    Set LesMails = Nothing
End Sub
 
Sub detache_et_imprime()
    Shell "C:\temp\color_printer.bat", 0
 
    Call detache_PJ
    Call PrintAllPDF
 
    MsgBox "Opération terminée, cliquez sur OK pour remettre l'imprimante par defaut"
    Shell "C:\temp\kyofax_printer.bat", 0
    Kill "C:\temp\*.pdf"
 
End Sub
C'est la macro detache_et_imprime qu'il faut lancer