[Toutes versions] Diffuser des Macros et Création de DLL (COM ADDIN)

Bonjour,
Il n'est pas facile de diffuser des Macros OUTLOOK sur d'autres PC, il faut

soit aller sur chaque poste et importer les .bas .frm etc.. ou faire du copier/coller

soit remplacer le fichier Vbaproject.otm, écrasant par la même les macros de l'utilisateurs (cela reste rare quand même je pense).

soit créer une DLL aussi appelée Complément (COM ADDIN)

Citation:

Une alternative aux 2 premiers points est de faire exécuter du code se trouvant dans un vbs ou un fichier macro Excel, on ne met que le minimum dans Outlook et quand on doit modifier son code on ne touche pas à celui d'Outlook (si on a bien cogité) je l'ai décrit là

Citation:

Pour des raisons de sécurité, il n'est malheureusement pas possible de créer des modules ou de recopier du code avec une macro comme dans Excel.

Voici donc comment créer "facilement" une dll.

On peut utiliser VSTO (Windev aussi me semble t'il) ou bien ce vieux VB6, c'est ce dernier que je vais utiliser.

Impératif il faut VB6 (Visual Basic 6), ce logiciel n'est plus commercialisé mais il a l'avantage d'utiliser du code quasi identique au vba.

On peut trouver des versions portables genre nanovb6 (vérifier la licence !)

Dans un premier temps, comme je n'avais pas prévu d'écrire cet article je vais vous renvoyer vers des sites (en anglais) qui décrivent le méthode :

Citation:

http://www.vbforums.com/showthread.p...ce-application

http://msdn.microsoft.com/en-us/library/aa140195.aspx

http://www.cpearson.com/excel/CreatingCOMAddIn.aspx
http://www.cpearson.com/excel/ComAddInInVB6.htm
http://support.microsoft.com/kb/316983

et là pour le ruban

http://msdn.microsoft.com/en-us/libr...ffice.14).aspx

http://blogs.msdn.com/b/frice/archiv...21/606463.aspx

Et là où cela devient facile, c'est que je vous joins un exemple de projet, qui comporte la création d'une barre d'outils et d'un bouton pour les versions avant OFFICE 12.

La modification des rubans Mail Explorer (3 boutons) et Mail Reader (2 boutons) pour les versions Office 2007 et suivant (j'utilise 2010 ).

Le déclenchement d'un évenement lors de l'envoi d'un Email.

Donc vous n'avez plus qu' à modifier et insérer votre code :-)

Voici le plus important le designer connect

Code:

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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
Option Explicit
 
Private WithEvents objOLApp As outlook.Application
Dim WithEvents objBtnExpRappel As Office.CommandBarButton
Dim WithEvents objBtnInsRappel As Office.CommandBarButton
 
Implements IRibbonExtensibility
 
 
 
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
                                       ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, _
                                       ByVal AddInInst As Object, custom() As Variant)
 
'Set my object to the host application.
    On Error GoTo AddinInstance_OnConnection_Error
 
 
    Set objOLApp = Application
    If Val(objOLApp.Version) < 14 Then
        Dim objBar As Office.CommandBar
        On Error Resume Next
        Set objBar = objOLApp.ActiveExplorer.CommandBars.item("DZ")
        If objBar Is Nothing Then
            Set objBar = objOLApp.ActiveExplorer.CommandBars.Add("DZ", msoBarTop, , True)
        End If
        On Error GoTo AddinInstance_OnConnection_Error
        Set objBtnExpRappel = objBar.Controls.Add(, , , 1, True)
        With objBtnExpRappel
            .FaceId = 2604
            .Caption = "[Bouton1]"
            .Style = msoButtonIconAndCaption
 
            ' The OnAction property is optional but recommended.
            ' It should be set to the ProgID of the add-in, such that if
            ' the add-in is not loaded when a user presses the button,
            ' Outlook loads the add-in automatically and then raises
            ' the Click event for the add-in to handle.
 
            .OnAction = "!<" & AddInInst.ProgId & ">"
        End With
        objBar.Visible = True
        'On Error Resume Next
        Dim objBarInsp As Office.CommandBar
        Dim oItm    'As outlook.MailItem
        Dim OItms    'As Outlook.Items
        'Set oItm = objOLApp.CreateItem(olMailItem)
        Set OItms = objOLApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
        If OItms.Count > 0 Then
            Dim j
            j = 0
 
            Do
                j = 1 + 1
                Set oItm = OItms(j)
                j = j + 1
            Loop While oItm.Class <> olMail
 
 
            'oItm.Display
            On Error Resume Next
            Set objBarInsp = oItm.GetInspector.CommandBars.item("read_DZ")
            objBarInsp.Delete
            If objBarInsp Is Nothing Then
                Set objBarInsp = oItm.GetInspector.CommandBars.Add("read_DZ", msoBarTop, , True)
            End If
            On Error GoTo 0    'AddinInstance_OnConnection_Error
            DoEvents
            Set objBtnInsRappel = objBarInsp.Controls.Add(, , , 1, True)
            '    DoEvents
            With objBtnInsRappel
                .FaceId = 2604
                .Caption = "[ Bouton1 ]"
                .Style = msoButtonIconAndCaption
 
                ' The OnAction property is optional but recommended.
                ' It should be set to the ProgID of the add-in, such that if
                ' the add-in is not loaded when a user presses the button,
                ' Outlook loads the add-in automatically and then raises
                ' the Click event for the add-in to handle.
 
                .OnAction = "!<" & AddInInst.ProgId & ">"
            End With
            objBarInsp.Visible = True
            oItm.Close olDiscard
        End If
        Set oItm = Nothing
    End If
 
    On Error GoTo 0
    Exit Sub
 
AddinInstance_OnConnection_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AddinInstance_OnConnection of Concepteur Connect"
    'Resume
End Sub
 
Private Sub objBtnExpRappel_Click(ByVal Ctrl As Office.CommandBarButton, _
                                  CancelDefault As Boolean)
    Go_BOUTON "BOUTON1"
End Sub
 
Private Sub objBtnInsRappel_Click(ByVal Ctrl As Office.CommandBarButton, _
                                  CancelDefault As Boolean)
    Go_BOUTON_Current "BOUTON1"
End Sub
 
Private Sub objOLApp_ItemSend(ByVal item As Object, Cancel As Boolean)
    Cancel = Fire_ItemSend(item, Cancel)
End Sub
 
 
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As _
                                          AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
 
'Clean up objects that are created during the OnConnection event.
    Set objOLApp = Nothing
End Sub
 
Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
'RibbonID indicates type of Inspector that is about to be displayed,
'   valid RibbonID values are as follows:
'Microsoft.Outlook.Mail.Read
'Microsoft.Outlook.Mail.Compose
'Microsoft.Outlook.MeetingRequest.Read
'Microsoft.Outlook.MeetingRequest.Send
'Microsoft.Outlook.Appointment
'Microsoft.Outlook.Contact
'Microsoft.Outlook.Journal
'Microsoft.Outlook.Task
'Microsoft.Outlook.DistributionList
'Microsoft.Outlook.Report
'Microsoft.Outlook.Resend
'Microsoft.Outlook.Response.Read
'Microsoft.Outlook.Response.Compose
'Microsoft.Outlook.Response.CounterPropose
'Microsoft.Outlook.RSS
'Microsoft.Outlook.Post.Read
'Microsoft.Outlook.Post.Compose
'Microsoft.Outlook.Sharing.Read
'Microsoft.Outlook.Sharing.Compose
 
    Select Case RibbonID
    Case "Microsoft.Outlook.Explorer"
        IRibbonExtensibility_GetCustomUI = GetRibbonXML_EXP()
    Case "Microsoft.Outlook.Mail.Compose"
    Case "Microsoft.Outlook.Mail.Read"
 
        IRibbonExtensibility_GetCustomUI = GetRibbonXML()
    End Select
End Function
 
 
Public Function GetRibbonXML() As String
    Dim sRibbonXML As String
 
 
    sRibbonXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2009/07/customui"" >" & _
                 "<ribbon>" & _
                 "<tabs>" & _
                 "<tab idMso=""TabReadMessage"">" & _
                 "<group id=""DZ.AB503B5"" label=""DZ"" imageMso=""RmsSendBizcardDesign"" insertBeforeQ=""GroupShow"" autoScale=""true"">" & _
                 "<button id=""readMail_BOUTON1"" label=""BOUTON1"" imageMso=""SendAgain"" size=""large"" onAction=""Clik_ribbon"" />" & _
                 "<button id=""readMail_BOUTON2"" label=""BOUTON2"" imageMso=""SendAgain"" size=""large"" onAction=""Clik_ribbon"" />" & _
                 "</group >" & _
                 "</tab>" & _
                 "</tabs>" & _
                 "</ribbon>" & _
                 "</customUI>"
 
    GetRibbonXML = sRibbonXML
 
End Function
 
Public Function GetRibbonXML_EXP() As String
    Dim sRibbonXML As String
 
 
    sRibbonXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2009/07/customui"" >" & _
                 "<ribbon>" & _
                 "<tabs>" & _
                 "<tab idMso=""TabMail"">" & _
                 "<group id=""DZ.AB503B5"" label=""DZ"" imageMso=""RmsSendBizcardDesign"" insertBeforeQ=""GroupQuickSteps"" autoScale=""true"">" & _
                 "<button id=""EXPLMail_BOUTON1"" label=""BOUTON1"" imageMso=""SendAgain"" size=""large"" onAction=""Clik_ribbon"" />" & _
                 "<button id=""EXPLMail_BOUTON2"" label=""BOUTON2"" imageMso=""SendAgain"" size=""large"" onAction=""Clik_ribbon"" />" & _
                 "<button id=""EXPLMail_OPTIONS"" label=""OPTIONS"" imageMso=""ControlsGallery"" size=""normal"" onAction=""Clik_ribbon"" showLabel=""false""/>" & _
                 "</group >" & _
                 "</tab>" & _
                 "</tabs>" & _
                 "</ribbon>" & _
                 "</customUI>"
 
    GetRibbonXML_EXP = sRibbonXML
 
End Function
 
Public Sub Clik_ribbon(ByVal control As IRibbonControl)
 
    Select Case control.Id
    Case "readMail_BOUTON1"
        Go_BOUTON_Current "BOUTON1"
    Case "EXPLMail_BOUTON1"
        Go_BOUTON "BOUTON1"
    Case "readMail_BOUTON2"
        Go_BOUTON_Current "BOUTON2"
    Case "EXPLMail_BOUTON2"
        Go_BOUTON "BOUTON2"
    Case "EXPLMail_OPTIONS"
        MsgBox "aucunes" 'FrmINI.Show
    Case Else
        MsgBox "Pas implémenté", vbCritical, "MonAddinDeveloppez"
    End Select
 
End Sub

Le projet comporte actuellement une référence à "Microsoft Outlook 11.0 Object Library" (ol2003) , si vous n'utilisez pas cette version il faut décocher cette référence dans projet /référence puis cocher la bonne
"Microsoft Outlook 14.0 Object Library" pour Office 2010 par exemple.
DAns l'objet Connect il faut également choisir l'équivalent dans Application version.

Pour débugger le code, il faut cliquer dans vb6 sur "executer"/"executer avec compilation complete", puis lancer OUTLOOK.

Pour créer/compiler la dll, une fois votre code prêt, vous cliquez sur Fichier/"Créer MonAddinDeveloppez.dll"

Pour installer\distribuer la dll, vous pouvez utiliser les possibilités de VB6, ou ce vbs

créer un fichier MonAddinDeveloppez.vbs

Code:

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
 
'installation d'une dll OUTLOOK parOliv-
Dim Destination
Dim Source
Dim Fichier
 
 
'Wait while Outlook.exe is running
Dim objWMIServices
Set objWMIServices = GetObject("winmgmts:\\localhost\root\CIMV2")
 
WScript.Sleep 3000    'Wait for 3 Second to ensure that the process list has been refreshed
ProcessRunning = True
Do Until Not ProcessRunning
    Set colProcessList = objWMIServices.ExecQuery("Select * from Win32_Process Where Name = 'OUTLOOK.EXE'")
    If colProcessList.Count = 0 Then
        ProcessRunning = False
        'msgbox "not running"
    Else
        ProcessRunning = True
        WScript.Sleep 5000    'Wait for 5 Second
        If MsgBox("Outlook est toujours ouvert", vbYesNo, "Réessayer ?") = vbNo Then
            WScript.Quit
        End If
    End If
Loop
 
Set Shell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
 
Destination = Shell.ExpandEnvironmentStrings("%appdata%") + "\Microsoft\Outlook\"
Source = "\\maSOURCE\OUTLOOK\"
Fichier = "MonAddinDeveloppez.dll"
 
go = fso.CopyFile(Source + Fichier, Destination)
 
 
Dim ret
ret = Shell.Run("RegSvr32 /s " & Chr(34) & Destination & Fichier & Chr(34), 1, True)
'MsgBox ret
If ret = 0 Then
    MsgBox "Mise à jour effectuée, vous pouvez relancer OUTLOOk"
ElseIf ret = 5 Then
    MsgBox "Vous devez avoir des droits d'administrateur !"
Else
    MsgBox "Une erreur s'est produite"
End If

Pour éviter le regedit en cas de maj de la dll (si on n'a pas les droits d'admin sur Windows) il faut cocher dans les propriétés du projet , onglet composant /version compatibilité /Binary Compatibilité et lui donner le chemin de la version précédente.

J'espère que cela va aider de nombreuses personnes.
A+