Oliv-

Voici comment afficher l'aperçu d'uen pièce jointe de l'Email actif qu'il soit sélectionné dans l'exporer actif ou ouvert .

Ici on affiche la première PJ

Il faut ajouter une référence à UIAutomationClient

TESTE SOUS OUTLOOK 2016

Code VB :

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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                                   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
'---------------------------------------------------------------------------------------
' Author    : Oliv
' Date      : 16/03/2018
' Purpose   : Outlook 2010/2016 Afficher l'aperçu de la pièce jointe
'---------------------------------------------------------------------------------------
'##############Please add reference ###############
'            UIAutomationClient
'##################################################
 
Option Explicit
 
Public OutlookVersion
Dim objWindows As Object
Dim OL As Object
 
Sub Go_Click_Apercu()
'Macro à lancer !
    Dim objmail
    If UCase(Application) = "OUTLOOK" Then
        Set OL = Application
    Else
        Set OL = CreateObject("outlook.application")
    End If
 
    OutlookVersion = Val(OL.Version)
 
    Set objWindows = OL.ActiveWindow
    If TypeOf objWindows Is Outlook.Inspector Then
        Set objmail = objWindows.CurrentItem
    Else
        Set objmail = objWindows.Selection(1)
    End If
 
    If objmail.Attachments.count > 0 Then
        Dim objAtt As Attachment
        Set objAtt = objmail.Attachments(1)
        apercu_pj_email_actif objAtt.FileName
    End If
 
End Sub
 
 
Function apercu_pj_email_actif(pjName As String) As String
'---------------------------------------------------------------------------------------
' Procedure : form_recherche_INPUT
' Author    : Oliv
' Date      : 04/03/2018
' Purpose   :
'---------------------------------------------------------------------------------------
'
 
'Declare UIAutomationClient variable
    Dim uiAuto As UIAutomationClient.CUIAutomation
    Dim elmRibbon As UIAutomationClient.IUIAutomationElement
    Dim elmRibbonTab As UIAutomationClient.IUIAutomationElement
    Dim cndProperty As UIAutomationClient.IUIAutomationCondition
    Dim aryRibbonTab As UIAutomationClient.IUIAutomationElementArray
    '
    Dim i As Long
 
    ' On Error Resume Next
    Set uiAuto = New UIAutomationClient.CUIAutomation
 
    Set elmRibbon = uiAuto.ElementFromHandle(ByVal Get_ol_hwnd)
 
    If elmRibbon Is Nothing Then
        Exit Function
    End If
 
    Dim ClasseCherchée
 
'    Select Case OutlookVersion
'    Case 12    '2007
'        ClasseCherchée = "RichEdit20W"
'    Case 14    '2010
'        ClasseCherchée = "NetUITextbox"
'        ' Case 16   'Outlook 2019
'        '   ClasseCherchée = "NetUISearchBoxTextbox"
'    Case Else    'à vérifier !!!!!!
'        ClasseCherchée = "NetUIHWND"
'    End Select
 
    ClasseCherchée = "NetUISimpleButton"
    Set cndProperty = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, ClasseCherchée)
 
    Set aryRibbonTab = elmRibbon.FindAll(TreeScope_Subtree, cndProperty)
    'MsgBox aryRibbonTab.Length
    For i = 0 To aryRibbonTab.Length - 1
        Debug.Print aryRibbonTab.GetElement(i).CurrentName
 
        If InStr(1, aryRibbonTab.GetElement(i).CurrentName, pjName, vbTextCompare) > 0 Then
            Set elmRibbonTab = aryRibbonTab.GetElement(i)
            Dim oUIAIP As IUIAutomationInvokePattern
            Set oUIAIP = elmRibbonTab.GetCurrentPattern(UIA_InvokePatternId)
            oUIAIP.Invoke
            Exit For
        End If
    Next
 
    DoEvents
 
    ClasseCherchée = "NetUIButton"
    Set cndProperty = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, ClasseCherchée)
 
    Set aryRibbonTab = elmRibbon.FindAll(TreeScope_Subtree, cndProperty)
    'MsgBox aryRibbonTab.Length
    For i = 0 To aryRibbonTab.Length - 1
        Debug.Print aryRibbonTab.GetElement(i).CurrentName
 
        If InStr(1, aryRibbonTab.GetElement(i).CurrentName, "Afficher l'aperçu du fichier", vbTextCompare) > 0 Then
            Set elmRibbonTab = aryRibbonTab.GetElement(i)
            Set oUIAIP = elmRibbonTab.GetCurrentPattern(UIA_InvokePatternId)
            oUIAIP.Invoke
            Exit For
        End If
    Next
 
 
End Function
 
 
 
Function Get_ol_hwnd() As LongPtr
'---------------------------------------------------------------------------------------
' Procedure : ActiveOutlook
' Author    : Oliv
' Date      : 16/03/2018
' Purpose   : Hwnd de OUTLOOK (explorer)
'---------------------------------------------------------------------------------------
    Dim OutlookCaption
    Dim hwnd As Long
    'OutlookCaption = OL.ActiveExplorer.Caption
    OutlookCaption = objWindows.Caption
    On Error Resume Next
 
    If OutlookCaption <> "" Then hwnd = FindWindow(vbNullString, OutlookCaption)
 
    If hwnd = 0 Then Exit Function
    Get_ol_hwnd = hwnd
End Function