Ouvrir par macro une pièce jointe

**mllrfrnck** · 18/02/2016, 11h15

Bonjour,

Est-il possible d'ouvrir une pièce jointe (une image principalement) par macro et d'imprimer par macro ce document ?
Malgré mes différentes recherches, je sèche à trouver une réponse à ce problème.

Franck

**Oliv-** · 18/02/2016, 11h22

Bonjour,
tu veux l'ouvrir ou l'imprimer ?

mais oui c'est possible

**mllrfrnck** · 18/02/2016, 11h31

Merci pour votre intervention rapide.
En fait je veux l'ouvrir et ensuite l'imprimer mais par macro.

Finalement, j'ai pratiquement réussi.
J'aurais voulu que l'image se sauvegarde via PDFcrator avec un nom prédonné et à un emplacement défini mais c'est déjà un bon début avec ça.
Je vous donne le code (plusieurs codes trouvés et adaptés à mon besoin) si ça peut aider d'autres personnes, il permet de pouvoir imprimer des pièces jointes via PDFCreator en sélectionnant cette imprimante et transfère le mail à qui vous souhaitez transmettre le mail en changeant l'objet du mail.

Mon code :

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub ShellImprime(fichier As String)
ShellExecute 0, "print", fichier, "", "C:\temp\", 0
End Sub
Sub ImprimePDF()

'---------------------------------------------------------------------------------------
' Procédure : ImprimePDF
' Auteur : Franck MULLER
' Date : 17/02/2016
'---------------------------------------------------------------------------------------
'
Dim blnEdit As Boolean
Dim Oitem, myAttachments As Object
Dim Ol As Outlook.Application
Dim myItem, objNewMail As MailItem
Dim I, y, z As Integer
Dim myInspector As Outlook.Inspector
Dim sFile As String

bPath = "C:\temp\"
If Dir(bPath, vbDirectory) = vbNullString Then
MkDir bPath
End If
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "MailItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
On Error GoTo OLMailErr
Set objNewMail = myInspector.CurrentItem.Reply
objNewMail.Display
With objNewMail
.To = votreadressemail
.Subject = votreobjetdumail
'Joindre les pièces, s'il y en a
For I = 1 To myItem.Attachments.Count
Call Impression
If InStr(1, myAttachments.Item(I).FileName, ".JPG") > 1 Or InStr(1, myAttachments.Item(I).FileName, ".jpg") > 1 Or InStr(1, myAttachments.Item(I).FileName, ".tiff") > 1 Then
sFile = bPath & myAttachments.Item(I).FileName
myAttachments.Item(I).SaveAsFile sFile
ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
pdfSave = bPath & myAttachments.Item(I).FileName
MsgBox "Pour que le fichier soit transformé en PDF, cliquer sur le bouton OK ci-dessous UNIQUEMENT lorsque vous aurez enregistré sur votre bureau la pièce jointe."
Kill pdfSave 'supprime le fichier
End If
Next I
If blnEdit Then
.Display
End If
End With
MsgBox "Opération terminée"
Set objNewMail = Nothing
Exit Sub
Else
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End If
End If
End Sub
Sub Impression()
'Nom de l'imprimante tel qu'écrit dans le panneau
'de configuration de Windows
Dim strComputer As String, objWMIService As Object
Dim colInstalledPrinters As Object, objPrinter As Object
Dim X As Variant, Arr()

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = _
objWMIService.execQuery("Select * from Win32_Printer")
For Each objPrinter In colInstalledPrinters
a = a + 1
Message = Message & a & " - Nom: " & objPrinter.Name & vbCrLf
ReDim Preserve Arr(1 To a)
Arr(a) = objPrinter.Name
Next
X = InputBox("Insérer le chiffre correspondant à l'imprimante PDFCreator." & _
vbCrLf & Message, "Choisissez une imprimante")
If X = False Then Exit Sub
If X < 1 Or X > UBound(Arr) Then
MsgBox "Votre numéro du choix de l'imprimante est " & _
"inexistant.", vbCritical + vbOKOnly, "Procédure avortée"
Exit Sub
End If

Call Imprimante_Par_Défaut(Arr(X))
End Sub

'-----------------------------------------
Sub Imprimante_Par_Défaut(Nom_Imprimante As Variant)
Dim strComputer As String, objWMIService As Object
Dim colInstalledPrinters As Object, objPrinter As Object

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = _
objWMIService.execQuery("Select * from Win32_Printer Where Name = '" & Nom_Imprimante & "'")
For Each objPrinter In colInstalledPrinters
objPrinter.SetDefaultPrinter
Next
End Sub

**Oliv-** · 18/02/2016, 12h30

et il se passe quoi entre l'ouverture et l'impression ?

en fait cela dépend beaucoup de ton type de PJ cela sera différent entre une image, un pdf et un document office.

si c'est juste l'ouvrir pour l'imprimer, en fait il faut l'enregistrer dans un dossier temporaire et l'imprimer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub PrintTo()
'Oliv 22 fev 2007
    Dim wshShell, SetdefaultPrinter
    LeFichier = "C:\Users\O\Pictures\cuicine_1.jpg"
    LaPrinter = "PDFCreator"
 
    Set wshShell = CreateObject("WScript.Shell")
    SetdefaultPrinter = "rundll32 shimgvw.dll,ImageView_PrintTo """ & LeFichier & """" & Chr(32) & """" & LaPrinter & """"
    wshShell.Run SetdefaultPrinter, 0, False
    Set wshShell = Nothing
End Sub

**mllrfrnck** · 18/02/2016, 14h30

En gros, j'ai, dans un mail, x pièces jointes au format image.
Je transfère le mail et je joins à ce mail les pièces jointes au format PDF.
Jusqu'au lancement de PDFCreator, pas de souci.
Le problème dans les 2 cas, le code que j'ai mis et ton code (merci d'ailleurs, il est beaucoup moins lourd que celui que j'ai mis), c'est que l'impression n'est pas automatique et qu'avec PDFCreator nous ne pouvons pas enregistrer directement le fichier dans un dossier en le renommant et l'ajouter ensuite au mail transféré.

**Oliv-** · 18/02/2016, 14h50

Il y a plusieurs façon de faire.

déjà il faut definir comment est lancée la macro

Manuellement ?
Via une règle ?
Autre ?

ensuite ce que tu veux faire avec tes PJ

convertir toutes les images en PDF
Certaines
que faire des autres PJ ?

faire 1 pdf par image ou 1 pdf par Email
etc

PDFCREATOR permet effectivement cela quelle version avez vous ? il y a d'autre solutions sans PDFCREATOR

**mllrfrnck** · 18/02/2016, 14h59

La macro est lancée manuellement via un bouton de la barre d'outils d'Accès Rapide.
Dans le code que j'ai mis au-dessus, les pièces jointes sont enregistrées à un endroit, pour être ensuite imprimées en PDF, ajoutées au mail transféré et enfin, elles sont supprimées de cet endroit.
Je définis dans le code les extensions que je veux convertir.
Faire un PDF par image me convient très bien.
Il s'agit de PDFCreator 1.6.0.

**Oliv-** · 18/02/2016, 16h03

3 façons d'y arriver

- utiliser PDFCREATOR (NE PAS DEPASSER LA VERSION 1.7.3 ) tu trouveras tout ce qu'il faut sur les post de kiki29

http://www.developpez.net/forums/d43...r/#post8001071

- utiliser pdfforge contenu dans PDFCREATOR jusqu'à la version 1.7.3

- utiliser WORD, tu importes dans word ton image, insères un saut de page, image suivante saut de page , etc ,... puis tu fais enregistrez-sous en PDF

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 ActiveDocument.ExportAsFixedFormat OutputFileName:="C:\exemple.pdf", _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
   "

ajoutes un DOEVENTS avant de supprimer ton fichier, ou supprimes tout à la fin, car des fois ça coince.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 DOEVENTS
Kill pdfSave 'supprime le fichier

**mllrfrnck** · 19/02/2016, 10h13

J'ai finalement réussi à faire la macro avec PDFCreator.
Je la mets ici pour ceux qui souhaitent l'utiliser :

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, _
    ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'For 64-Bit
'Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Public Sub Pause(intSeconds As Variant)
  ' Comments: Waits for a specified number of seconds
  ' Params  : intSeconds      Number of seconds to wait
  ' Source  : Total Visual SourceBook
 
On Error GoTo PROC_ERR
 
    Dim datTime As Date
    datTime = DateAdd("s", intSeconds, Now)
    Do
        ' Yield to other programs (better than using DoEvents which eats up all the CPU cycles)
        Sleep 100
        DoEvents
    Loop Until Now >= datTime
PROC_EXIT:
    Exit Sub
 
PROC_ERR:
    MsgBox "Error: " & Err.Number & ". " & Err.Description, , "Pause Method"
    Resume PROC_EXIT
End Sub
 
Sub ShellImprime(fichier As String)
        ShellExecute 0, "print", fichier, "", "C:\temp\", 0
End Sub
 
Sub ImprimePDF()
 
Dim blnEdit As Boolean
Dim Oitem, myAttachments As Object
Dim Ol As Outlook.Application
Dim myItem, objNewMail As MailItem
Dim I, y, z As Integer
Dim myInspector As Outlook.Inspector
Dim sFile, OutputFilename As String
Dim wshShell, SetdefaultPrinter, GetDefaultPrinter
Dim PDFCreator1 As PDFCreator.clsPDFCreator
Dim c As Long
 
GED.Show
 
LaPrinter = "PDFCreator"
bPath = "C:\temp\"
a = nom_donne_au_PDF
If Dir(bPath, vbDirectory) = vbNullString Then
    MkDir bPath
End If
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
    If TypeName(myInspector.CurrentItem) = "MailItem" Then
        Set myItem = myInspector.CurrentItem
        Set myAttachments = myItem.Attachments
        On Error GoTo OLMailErr
        Set objNewMail = myInspector.CurrentItem.Reply
        objNewMail.Display
        With objNewMail
            .To = votreadressemail
            .Subject = votreobjetdumail
             'Joindre les pièces, s'il y en a
            For I = 1 To myItem.Attachments.Count
                'Call Impression
                If InStr(1, myAttachments.Item(I).Filename, ".JPG") > 1 Or InStr(1, myAttachments.Item(I).Filename, ".jpg") > 1 Or InStr(1, myAttachments.Item(I).Filename, ".tiff") > 1 Then 'indiquer les extensions qui seront convertis en PDF
                    sFile = bPath & a & "_" & I & "." & Mid(myAttachments.Item(I).Filename, InStrRev(myAttachments.Item(I).Filename, ".") + 1)
                    myAttachments.Item(I).SaveAsFile sFile
                    fichier_pdf = bPath & a & "_" & I & ".pdf"
                    Set PDFCreator1 = New clsPDFCreator
                    With PDFCreator1
                        .cStart "/NoProcessingAtStartup"
                        .cOption("UseAutosave") = 1
                        .cOption("UseAutosaveDirectory") = 1
                        .cOption("AutosaveDirectory") = "C:\temp"
                        .cOption("AutosaveFilename") = a & "_" & I
                        .cOption("AutosaveFormat") = 0                            ' 0 = PDF
                        DefaultPrinter = .cDefaultPrinter
                        .cDefaultPrinter = "PDFCreator"
                        .cClearCache
                    'myAttachments.Item(I).SaveAsFile sFile
                    Set wshShell = CreateObject("WScript.Shell")
                    SetdefaultPrinter = "rundll32 shimgvw.dll,ImageView_PrintTo """ & sFile & """" & Chr(32) & """" & LaPrinter & """"
                    wshShell.Run SetdefaultPrinter, 0, False
                    Set wshShell = Nothing
                    'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0
                        DoEvents
                        .cPrinterStop = False
                        OutputFilename = PDFCreator1.cOutputFilename
.cOption("UseAutosave") = 0
.cOption("UseAutosaveDirectory") = 0
                    End With
                    Pause 10
                    If OutputFilename = "" Then
                    MsgBox "Création du fichier PDF en cours." & vbCrLf & vbCrLf & _
                    "Une erreur s'est produite : Temps imparti !", vbExclamation + vbSystemModal
                    End If
                    .Attachments.Add (fichier_pdf)
                    Kill sFile 'supprime le fichier
                    Kill fichier_pdf 'supprime le fichier
                End If
            Next I
    If blnEdit Then
        .Display
    End If
        End With
    MsgBox "Opération terminée"
    Set objNewMail = Nothing
    Exit Sub
    Else
OLMailErr:
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
    Exit Sub
    End If
End If
End Sub

**Oliv-** · 19/02/2016, 10h39

Super !

Avec PDFCREATOR je mettais cela pour attendre la fin de la génération en pdf (où tu as le pause 10, car 10 secondes ca peut être long ou trop court)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 'Wait until the PDF file shows up then release the objects
                Do Until Dir(fichier_pdf ) <> ""
                    DoEvents
                Loop

Tu devrais peut être mettre un Doevents après .Attachments.Add (fichier_pdf) ou un pause 1 juste avant les suppressions de fichiers

**mllrfrnck** · 19/02/2016, 12h22

Merci Oliv- pour ta disponibilité, j'ai rajouté tes 2 suggestions.
Encore merci, bonne journée et bon week-end.

Ouvrir par macro une pièce jointe [OL-2010]

VBA Outlook

Discussions similaires

Partager

Partager