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:
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 ?
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
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%:
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.
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
j'ai donc fait 2 Batchs:
1 pour mettre l'imprimante couleur par defaut : color_printer.bat
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 hpcolorcp1515 RUNDLL32 PRINTUI.DLL,PrintUIEntry /y /n \\94.0.0.6\hpcolorcp1515
Voilà, c'est peut etre pas la meilleure méthode, mais en tout cas ca marche
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
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.
C'est la macro detache_et_imprime qu'il faut lancer
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![]()
Partager