Discussion :

[ArchiSi]

Bonjour,
J'ai recupere ce code pour afficher mon calendrier via mon navigateur web dans un format proche de celui du papier, ce qui est très utile pour la gestion de projet.
Nativement il fait choisir entre calendrier vierge (ce qui fonctionne dans mon OL2010 du bureau comme dans mon OL2010 perso) et calendrier renseigné (c'est là que ca se corse).
Il permet d'esclure certaines catégories.
En l'etat il fonctionne toujours sur mon OL2010 perso pour un calendrier renseigné, il ne fonctionne qu'aléatoirement sur l'OL2010 de mon bureau. en d'autres terme parfois la macro se termine correctement et donne le resultat voulu, mais le plus souvent outlook se bloque ou plante.
je n'ai pas d'explication.
touty en cherchant, j'ai ajoute la variable Debug, et j'ai ajoute de quoi ne selectionner qu'une catégorie (categorie à cacher, catégorie a inclure), mais c'est juste parce que je bloque sur mon soucis de panne aléatoire.
Comme solution pliative, loin d'être satisfaisante, j'exporte mon OST au format PST en local, puis je réouvre mon PST dans mon OL2010 et la pas de soucis cela fonctionne. J'ai tendance à conclure que c'est la liason avec exchange qui pose soucis.
le Problème est que je n'arrive pas a décortiquer ce script ...

Ci joint le source au cas ou qq'un auri une idée :

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
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
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
Sub YearCalCAT()
    MsgBox ("YearCalCAT")
'copyright Nick Roemer
'http://niveauverleih.blogspot.com/
'version 1.9, 22 Jan 2009
 
'copy and paste this code into your Outlook Visual Basic Editor
'Therefore just press Alt+F11 in your Outlook
'Right click on 'Modules'
'choose 'insert/module'
'paste the code in the big white window on the right hand side
'Run it from Outlook via Tools/Macro/Macros/DisplayYearlyCalendar
 
'this macro will display your Outlook appointments over a period of several months
'or an empty calendar to print out
'the output is an html file that is displayed with Internet Explorer
'-------------------------------------------------------------------
Const Dbg = False
 
'list here the categories that you want to hide               'Lister ici les categories à ignorer
'e.g. arrExcludeCategories = Array("@home", "Personal")
arrExcludeCategories = Array("PERSO\KID")
 
'PERSONALISATION                                              'Lister ici les catégories à prendre en compte
arrIncludeCategories = Array("DGRI\QUAL\B5")
 
'Set this to TRUE if you want to display private appointments
Const blShowPrivateAppointments = True
 
'Set this to FALSE if you want the rows to be the day of month (1,2, ...31) iso. the days of the week (Mo.. Fri)
Const blAlignWeekDays = True
 
'Set this to TRUE if you want to display AllDayEvents only
blAllDayEventsOnly = False
 
    'colors from http://web.njit.edu/~kevin/rgb.txt.html
    Const wheat_light = "#EED8AE"
    Const wheat_dark = "#CDBA96"
    Const seashell = "#EEE5DE"
    Const silver = "#C0C0C0"
 
    Const forwrite = 2
 
    Set objShell = CreateObject("WScript.Shell")
    strTempFolder = objShell.ExpandEnvironmentStrings("%TEMP%")
    strHtmlFile = strTempFolder & "\YearlyCalCAT.html"
 
    StartMonth = InputBox("Start Month _ entrer le numéro du premier mois de la vue", "Start Month", Month(Date))
    If StartMonth = "" Then Exit Sub
    StartMonth = CInt(StartMonth)
 
    EndMonth = InputBox("End Month", "End Month _ dernier mois de mois de la vue", StartMonth - 1)
    If EndMonth = "" Then Exit Sub
    EndMonth = CInt(EndMonth)
 
    If EndMonth < StartMonth Then
        NbMonths = EndMonth - StartMonth + 13
        EndMonth = EndMonth + 12
    Else
        NbMonths = EndMonth - StartMonth + 1
    End If
 
    strEmptyCalendar = MsgBox("Calendrier Vierge ?" + Chr(10) + Chr(13) + "Empty Calendar?", vbYesNo + vbDefaultButton2)
    If Dbg Then MsgBox ("Calendrier Vierge , Valeur Saisie : " + CStr(strEmptyCalendar))
 
    'Create Table:  1 Header Row
    '               7 days x 5 weeks = 35 day rows
    '               1 Header column
    '               1 column for each month
 
    Contents = "<head><title>Yearly Calendar</title></head>"
 
    Contents = Contents & vbCrLf & "<Table width=100% border=1 cellpadding=5 style='font-family:verdana;font-size:80%'>"
 
    'header row
    Contents = Contents & vbCrLf & "<TR valign='top' bgcolor='" & seashell & "'>"
    Contents = Contents & vbCrLf & "<TH>" & "Month" & "</TH>"
 
    'First Row
    intYear = Year(Date)
    nextYear = intYear + 1
    If Dbg Then MsgBox ("DEBUG ____ First Row, intYear : " + CStr(intYear) + ", nextYear : " + CStr(nextYear))
 
    For i = StartMonth To EndMonth
        MonthInNumbers = i
        If i > 12 Then
            MonthInNumbers = i - 12
            intYear = nextYear
        End If
        Contents = Contents & vbCrLf & "<TH width='" & 1 + Int(100 / (NbMonths + 1)) & "%'>" & MonthName(MonthInNumbers) & " " & intYear & "</TH>"
        If Dbg Then MsgBox ("DEBUG ____ First Row, For i = StartMonth To EndMonth, Valeur de i : " + CStr(i))
    Next
    Contents = Contents & vbCrLf & "</TR>"
 
    If strEmptyCalendar = vbNo Then
        If Dbg Then MsgBox ("DEBUG ____ First Row,If strEmptyCalendar = vbNo ... : Calendrier vierge = non")
 
        Set onNamespace = GetNamespace("MAPI")
 
    '   Set MyFolder = onNamespace.GetDefaultFolder(9).Items
    'change the following line to 'Set MyFolder = onNamespace.PickFolder.Items'
    'if you want to select your calendar folder manually (if you have several)
       Set MyFolder = onNamespace.PickFolder.Items
 
        MyFolder.Sort "[Start]"
        MyFolder.IncludeRecurrences = True
    End If
 
    'Day Rows
            If Dbg Then MsgBox ("DEBUG ____ Day Row ")
    RowCount = 0
    For week = 1 To 6               'The macro was originally written for the case blAlignWeekDays = True
        For intWeekday = 1 To 7     'Therefore the I used a double loop: weeks then weekdays
            RowCount = RowCount + 1
 
            'First column
            If Dbg Then MsgBox ("DEBUG ____ Day Row, First column, blAlignWeekDays " + CStr(blAlignWeekDays))
            Contents = Contents & vbCrLf & "<TR valign='top' bgcolor='" & bgcolor & "'>"
            If blAlignWeekDays Then
                Contents = Contents & vbCrLf & "<TD bgcolor='" & seashell & "'>" & WeekdayName(intWeekday, False, vbMonday) & "</TD>"
                'If Dbg Then MsgBox ("blAlignWeekDays ... No jour de la semanie " + CStr(week) + ", intWeekday " + CStr(intWeekday))
            Else
                Contents = Contents & vbCrLf & "<TD bgcolor='" & seashell & "'><b>" & RowCount & "</b></TD>"
                'If Dbg Then MsgBox ("NO blAlignWeekDays ! No jour de la semanie " + CStr(week) + ", intWeekday " + CStr(intWeekday))
            End If
 
            intYear = Year(Date)
            'Month columns
            If Dbg Then MsgBox ("DEBUG ____ Day Row, Month columns, StarMonth " + CStr(StartMonth) + ", EndMonth " + CStr(EndMonth))
            For i = StartMonth To EndMonth
                MonthInNumbers = i
                If i > 12 Then
                    MonthInNumbers = i - 12
                    intYear = nextYear
                End If
 
                StrMonthStartsOnA = 1
                If blAlignWeekDays Then     'e.g. if the first of the month falls on a Friday
                                            ' we need to put some grey cells before the month begins
                    StrMonthStartsOnA = Weekday(CDate("1 " & MonthName(MonthInNumbers) & ", " & intYear), vbMonday)
                End If
 
                intDayOfMonth = 0
                If RowCount >= StrMonthStartsOnA Then
                    intDayOfMonth = RowCount - StrMonthStartsOnA + 1
                End If
 
                'calculate date for current cell
                strDate = ""
                If intDayOfMonth > 0 Then
                On Error Resume Next
                    strDate = CDate(CStr(intDayOfMonth) & " " & MonthName(MonthInNumbers) & ", " & CStr(intYear))
                On Error GoTo 0
                End If
 
                'color weekends
                intRealWeekday = intWeekday
                If Not blAlignWeekDays Then
                    On Error Resume Next
                    intRealWeekday = Weekday(strDate)      'Weekday(DateAdd("d", -1, strDate))
                    On Error GoTo 0
                End If
 
                bgcolor = "#FFFFFF"
                Select Case intRealWeekday
                    Case 7
                        bgcolor = wheat_light
                    Case 1
                        bgcolor = wheat_dark
                End Select
 
                If blAlignWeekDays Then
                    bgcolor = "#FFFFFF"
                    Select Case intRealWeekday
                        Case 6
                            bgcolor = wheat_light
                        Case 7
                            bgcolor = wheat_dark
                    End Select
                End If
 
 
                'grey out empty cells
                dispDate = ""
                If strDate = "" Then
                    bgcolor = silver
                ElseIf blAlignWeekDays Then
                    dispDate = "<b>" & Day(strDate) & " " & MonthName(MonthInNumbers, True) & "</b>"
                Else 'if blAlignWeekDays = False
                    dispDate = "<b>" & Day(strDate) & " " & WeekdayName(intRealWeekday, True, vbSunday) & "</b>"
                End If
 
                'display date
                Contents = Contents & vbCrLf & "<TD bgcolor = '" & bgcolor & "'>" & dispDate & " "
 
                'display appointments
                If strEmptyCalendar = vbNo Then
                    strRestriction = "(([Start] >= '" & strDate & " 12:00 am' AND [Start] <= '" & strDate & " 11:59 pm')"
                    strRestriction = strRestriction & " OR ([End] > '" & strDate & " 12:00 am' AND [End] <= '" & strDate & " 11:59 pm')"
                    strRestriction = strRestriction & " OR ([Start] < '" & strDate & " 12:00 am' AND [End] > '" & strDate & " 11:59 pm'))"
                    strRestriction = strRestriction & " AND [Duration] > 0"
                    If strDate = "" Then strRestriction = "[Start] = 1" 'no result
                    'If Dbg Then MsgBox ("'display appointments ..., month i " + CStr(i) + ", If strEmptyCalendar = vbNo , strRestriction : " + CStr(strRestriction))
                    If Dbg Then MsgBox ("DEBUG ____ Day Row, display appointments, strDate " + CStr(strDate))
                    On Error Resume Next
                    Set myRestrictItems = MyFolder.Restrict(strRestriction)
                    On Error GoTo 0
            myRestrictItems.Sort "[Start]"
 
            If Dbg Then MsgBox (" DEBUG ____ Day Row, display appointments, ***  myRestrictItems.count " + CStr(myRestrictItems.Count))
 
 
            'Contents = Contents & vbCrLf & myRestrictItems.Count & "<br>"
                        For Each myItem In myRestrictItems
 
                        blDisplay = False
 
                        'Passage à True si la catégorie fait parti des catégories à afficher
                        For Each strCat2Exclude In arrIncludeCategories
                            If InStr(myItem.Categories, strCat2Exclude) Then blDisplay = True
                        Next
 
                        ' Sauf si elle fait partie des catégories a cacher
                        'check if this appointment is in a category that we want to hide
                        For Each strCat2Exclude In arrExcludeCategories
                            If InStr(myItem.Categories, strCat2Exclude) Then blDisplay = False
                        Next
 
                      '  'check if this is a private appointment
                       ' If blShowPrivateAppointments = False And myitem.Sensitivity = 2 Then blDisplay = False
                      '
                      '  blIsAllDayEvent = myitem.AllDayEvent
                      '  If blAllDayEventsOnly And Not blIsAllDayEvent Then blDisplay = False
                    '
                        If Dbg Then MsgBox ("For Each myitem In myRestrictItems, blDisplay " + CStr(blDisplay) + ", myitem.EntryID " + CStr(myItem.EntryID))
                      '
                      '  'Display the appointment
                        If blDisplay Then
                            strTime = ""
                            If Not blIsAllDayEvent Then
                                strTime = "<br>" & Hour(myItem.Start) & "h"
                                If Minute(myItem.Start) <> 0 Then strTime = strTime & Minute(myItem.Start)
                                strTime = strTime & " "
                            End If
 
                            Contents = Contents & strTime & "<a href=""outlook:" & myItem.EntryID & """ style=""background-color: " & GetColor(myItem) & """>" & myItem.Subject & vbCrLf & "</a>"
                        End If
                        Next
                Else
                    Contents = Contents & "<br><br>"
                End If
 
                Contents = Contents & vbCrLf & "</TD>"
 
            Next
            Contents = Contents & vbCrLf & "</TR>"
           If Dbg Then MsgBox ("week = " + CStr(week) + " And intWeekday = " + CStr(2) + "Contents " + CStr(Contents))
           If blAlignWeekDays And week = 6 And intWeekday = 2 Then Exit For 'latest possible day in last week is Tuesday (31 days from Sunday)
           If (Not blAlignWeekDays) And RowCount = 31 Then Exit For
        Next
        If (Not blAlignWeekDays) And RowCount = 31 Then Exit For
    Next
 
    'create the html file
    Set filesys = CreateObject("Scripting.FileSystemObject")
    Set F = filesys.OpenTextFile(strHtmlFile, forwrite, True)
    F.Write Contents
 
    'display the html file
    Set wshell = CreateObject("WScript.Shell")
    strCommand = "iexplore """ & strHtmlFile & """"
 
    wshell.Run (strCommand)
 
End Sub
 
 
 
Function GetColor(objAppt)
'http://ms-office-forum.net/forum/archive/index.php/t-143024.html
 
On Error Resume Next 'Important!
 
Const CdoPropSetID1 = "0220060000000000C000000000000046"
Const CdoAppt_Colors = "0x8214"
 
Set objCDO = CreateObject("MAPI.Session")
 
objCDO.Logon "", "", False, False
If objAppt.Class = olAppointment Then
 
Set objMsg = objCDO.GetMessage(objAppt.EntryID, objAppt.Parent.StoreID)
Set colFields = objMsg.Fields
Set objField = colFields.Item(CdoAppt_Colors, CdoPropSetID1)
'objField.Value is 0-8
'1=Important, 2=Business,....
 
ColorCode = objField.Value
Else
ColorCode = 0
End If
 
GetColor = ""
 
Select Case ColorCode
    Case 1          'Important
        GetColor = "FA8072"
    Case 2          'Business
        GetColor = "6495ED"
    Case 3          'Personal
        GetColor = "9ACD32"
    Case 4          'Vacation
        GetColor = "F5F5DC"
    Case 5          'Must Attend F4A460
        GetColor = "F4A460"
    Case 6          'Travel Required
        GetColor = "AFEEEE"
    Case 7          'Needs preparation
        GetColor = "C1BC5B"
    Case 8          'Birthday
        GetColor = "9370DB"
    Case 9          'Anniversary
        GetColor = "6FA898"
    Case 10         'Phonecall
        GetColor = "F5C94D"
End Select
 
End Function

Ps je n'ai pas trouver les contacts de l'auteur, au cas ou il se reconnaitrait

[ArchiSi]

Bonjour,
Dans l'idee : la macro fonctionne sur mon poste personnel avec un calendrier PST importé dans OL2010, je cherche une solution de Synchro entre les deux postes de travail, sachant que le poste cible (personnel) ne peut pas etre connecté au serveur Exchange maître (protection par des certificats etc ...). En d'autres termes je cherche à automatiser l'export du calendrier au format OST depuis le Ms Outlook du bureau qui est installé sur un poste pour lequels je n'ai pas les droits admin, vers un calendrier au format PST dans un fichier local.

Je tombe sur le logiciel Sync2 qui prétent synchroniser deux outlook de postes de travail différent, via un support de stokage USB
Probleme, il necessite l'installation sur le poste avec Ms Oulook 2010 connecté à exchange, ce qui rend invalide la solution car ce dernier appartient au bureau, et je ne suis pas administrateur.

Quelqu'un connaitrait il une alternative à Sync2, en version portable ?

MErci d'avance de votre aide

[ArchiSi]

Re
bon sinon il y aurait une autre hypothèse de travail :
faire exporter regulièrement dans un fichier le calendrier par défaut
pour ca il y a le code ci-dessous (il fonctionne et me fait bien un fichier ics)

Mais là ou je ne suis vraiment pas assez calée, c'est que pour envisager cette solution, il faudrait que
- les deux poste partage un meme repertoire, ou le maitre depose son export, et l'exclave lit ce depot.
- tant que MsOutlook 2010 du poste de travail maître (celui du taf ou je n'ai aucun droits) reste ouvert, il y ait un pocessus qui tout les X secondes relance cette macro (une sorte de CRON)
- tant que MsOutlook 2010 du poste de travail exclave (perso ou j'ai tout les droits) reste ouvert, il y ait un autres pocessus qui tout les Y secondes (ou a la demande) relance une autre macro qui supprime l'agenda précédent, puis ré-importe l'agenda depuis le fichier créer par le poste maitre.

Cela me ferait encore trois source a écrire (le cron d'export du maitre, le cron d'import de l'esclave, les stop et lance de ces cron) ...

bah je ne sens pas vraiment

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
Public Sub ExportEntireDefaultCalendar()
 
'source : https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/calendarsharing-saveasical-method-outlook
'The following Visual Basic for Applications (VBA) example
'creates a CalendarSharing object for the Calendar folder,
'then exports the contents of the entire folder
'(including attachments and private items) to an
'iCalendar calendar (.ics) file.
 
 Const Dbg = False
 Const nomMacro = "ExportEntireDefaultCalendar"
 Const nomExport = "C:\Users\eprevost\Documents\TEST\ExportEntireDefaultCalendar.ics"
 
    MsgBox "Fichier export = " & nomExport, vbOKOnly, "Titre MsgBox: MACRO " & nomMacro
 
 
 Dim oNamespace As NameSpace
 Dim oFolder As Folder
 Dim oCalendarSharing As CalendarSharing
 
 On Error GoTo ErrRoutine
 
 ' Get a reference to the Calendar default folder
   Set oNamespace = Application.GetNamespace("MAPI")
   Set oFolder = oNamespace.GetDefaultFolder(olFolderCalendar)
 
 ' Get a CalendarSharing object for the Calendar default folder.
   Set oCalendarSharing = oFolder.GetCalendarExporter
 
 ' Set the CalendarSharing object to export the contents of
 ' the entire Calendar folder, including attachments and
 ' private items, in full detail.
 
 With oCalendarSharing
 .CalendarDetail = olFullDetails
 .IncludeWholeCalendar = True
 .IncludeAttachments = True
 .IncludePrivateDetails = True
 .RestrictToWorkingHours = False
 End With
 
 ' Export calendar to an iCalendar calendar (.ics) file.
 oCalendarSharing.SaveAsICal nomExport
 If Dbg Then
    MsgBox nomExport & " Exporté avec succès", vbOKOnly, "Titre MsgBox: MACRO " & nomMacro
 End If
EndRoutine:
 
 On Error GoTo 0
 Set oCalendarSharing = Nothing
 Set oFolder = Nothing
 Set oNamespace = Nothing
 
    MsgBox "FIN DE MACRO , voir le fichier " & nomExport, vbOKOnly, "Titre MsgBox: MACRO " & nomMacro
Exit Sub
 
 
 
ErrRoutine:
 
 Select Case Err.Number
 
 Case 287 ' &;H0000011F
 
 ' The user denied access to the Address Book.
 ' This error occurs if the code is run by an
 ' untrusted application, and the user chose not to
 ' allow access.
 
 MsgBox "Access to Outlook was denied by the user.", _
         vbOKOnly, CStr(Err.Number) + " - " + CStr(Err.Source)
 
 Case -2147467259 ' &;H80004005
 
 ' Export failed.
 ' This error typically occurs if the CalendarSharing
 ' method cannot export the calendar information because
 ' of conflicting property settings.
 
 MsgBox Err.Description, vbOKOnly, CStr(Err.Number) + " - " + Err.Source
 
 Case -2147221233 ' &;H8004010F
 
 ' Operation failed.
 ' This error typically occurs if the GetCalendarExporter method
 ' is called on a folder that doesn't contain calendar items.
 
 MsgBox Err.Description, vbOKOnly, CStr(Err.Number) + " - " + Err.Source
 
 Case Else
 
 ' Any other error that may occur.
 
 MsgBox Err.Description, vbOKOnly, CStr(Err.Number) + " - " + Err.Source
 
 End Select
 
 
 GoTo EndRoutine
 
End Sub

[ArchiSi]

Procedons par étapes :

j'essaye de lancer la macro qui exporte mon fichier au format ics (cela fonctionne à la main) via un vbs que je poyurrait lancer dans le scheduler de windows (dumoins je l'esperre) à intervale de temps regulier (toute les 2 heures par exemple).

J'ai colle le code du Sub ExportEntireDefaultCalendar dans ThisOutlookSession (général)
Bizarrement c'est la seule macro que je peut desormais executer en directe depuis le selecteur de macro de l'onglet developpeur. Pour toute les autres je dpois d'abord ouvrir VBA, et cliquer sur le triangle vert run, puis selectionner la macro ...

j'essaye de me dépatouiller avec le code d'Oliv ci-dessous rappelé (avec deux ou trois pisteurs en plus trouver ou ca cloche)

Mais sans succes pour l'instant ...

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
 
'##############DEBUT ###############
'By Oliv 29 juin 2007
Set WshShell = WScript.CreateObject("WScript.Shell")
 
'Lance une macro dans OUTLOOK
Dim theApp, theNameSpace, theMailItem
Set theApp = WScript.GetObject("","Outlook.Application")
 
If theApp Is Nothing Then
	Set theApp = WScript.CreateObject("Outlook.Application")
	MsgBox "Outlook était fermé"
	If theApp Is Nothing Then 
		MsgBox "Could not access Outlook - shutting down"
	end if
else
	MsgBox  "Outlook était ouvert"
End if
 
'**** CA CA FONCTIONNE : IL TROUVE LE MAIL ACTIF
Set theNameSpace = theApp.GetNamespace("MAPI")
MsgBox  "the name space"
On error resume next
Set theMailItem = theApp.activeInspector.currentitem
Msgbox "Le mail actif est " & theMailItem.subject
'**** CA CA FONCTIONNE : IL TROUVE LE MAIL ACTIF 
 
'ici on lance une macro du nom de toto dans ThisOutlookSession.
' ok alors le toto doit être le nom du Sub qu'on a mis dans ThisOutlookSession
MsgBox  "Call Application"                                                'pour voir si je passe par là
 
'WScript.call theApp.coucou                                             'test avec une macro qui n'est pas dans ThisOutlookSession => rien
'Call Application.HelloWorld("world")                                 'test avec une macro qui est dans ThisOutlookSession => rien
'Call theApp.HelloWorld("world")                                      'test avec une macro qui est dans ThisOutlookSession => rien
'WScript.Call theApp.HelloWorld("world")                          'test avec une macro qui est dans ThisOutlookSession => rien
'theApp.run HelloWorld("world")                                       'provoque une erreur (je crois enfi c'est sur ca ne marche pas)
'theApp.HelloWorld("world")                                                'test avec une macro qui est dans ThisOutlookSession => rien
 
 
'Call theApp.ThisOutlookSession.HelloWorld("world")             'test avec une macro qui est dans ThisOutlookSession => rien
'Call theApp.ThisOutlookSession.ExportEntireDefaultCalendar 'test avec une macro qui est dans ThisOutlookSession => rien
'Call theApp.ExportEntireDefaultCalendar
'theApp.call.ExportEntireDefaultCalendar
'Call Projet1.ThisOutlookSession.ExportEntireDefaultCalendar
'Execute theApp.Projet1.ThisOutlookSession.ExportEntireDefaultCalendar
theApp.ExportEntireDefaultCalendar()
 
 
 
 
MsgBox  "Fin"  'je passe par là, donc le vbs ne plante pas, mais il n'execute pas ma marco
 
 
  set theApp = nothing
  Set theNameSpace= Nothing
  Set theMailItem= Nothing
'##############FIN##############################"

petite précision : si outlook est fermé, le vbs l'ouvre bien mais il n'affiche pas le message "outlook etait fermé", il affiche "outlook etait ouvert".


merci d'avance pour toute aide

cordialeme,t

[Oliv-]

Bonsoir,
Contrairement à EXCEL, on ne peut plus (c'était faisable avec des versions antérieures à 2010)lancer directement une macro qui se trouve dans OUTLOOK via un VBS.

Il faut soit tout lancer à partir du VBA ou d'une macro dans EXCEL pas exemple qui contrôle par AUTOMATION OUTLOOK.

Il y a une solution tout de même pour lancer une macro DANS OUTLOOK.


on utilise l'événement REMINDER dans ThisOUtlookSession

Code :

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

1
2
3
4
5
Private Sub Application_Reminder(ByVal Item As Object)
if Item.subject = "#GOmaMACRO" then
   call MaMacroOutlook
End if
End Sub

On crée une tache qui se nomme PRÉCISÉMENT "#GOmaMACRO" et on met un rappel à souhait, avec une répétition

Lors du déclenchement du rappel l'évenement va lancer la macro

[ArchiSi]

Merci de la réponse,
ca c'est une idée passer par le reminider (si je traduis donc une sorte de gestionnaire de rappel).

J'ai essayer d'appeler une macro du module ca ne marche pas et produit une erreur : ce n'est pas un module qui est attendu. Donc j'ai essayé avec une macro qui est dans le corps de ThisOutlookSession, c a l'aire de fonctionner, j'ai bien ma boite de dialoguer hello World.

je me permets de mettre les copies d'écrans
1 du ThisOutlookSession
2 de la tache
3 du resultat de la tache (attendu)
4 du resultat secondaire (supperflu)

Question que dois je modifier dans la tache pour que le résultat ne soit pas récapitulé dans une une liste de rappel, mais uniquement l'exécution de la macro ?

1. Code :
2. Tâche :
3. Result :
4.


Merci de votre aide,
Bien cordialement,

ArchiSI

[Oliv-]

A priori lors de l'affichage du rappel, il doit déclencher le MSGBOX COUCOU!

on peut même arriver à squizzer cet affichage du rappel pour n'avoir que la macro

[ArchiSi]

Merci, je viens de voir votre réponse, pendant que je me disputait avec mon ordinateur pour déposer les copies d'écrans (argnh)
je confirme j'ai bien la boite de dialogue Hello World, a condition que le sub soit bien dans la partie ThisOutlookSession. En revanche, je ne sais pas comment éviter la récap des rappels de taches.

Ce qui est bizzare dans outlook, c'est qu'il semble être impossible d'appeler les macros écrites dans la partie Modules depuis ThisOutlookSession et vice vers ca.
-- du coup je me demande à quoi servent les modules, qui semble pourtant être une bonne solution pour faire de la prg propre, mais c'est une appartée --

Si je n'arrive pas a masquer la recap des rappels, il faut que je trouve un moyen de ne l'avoir qu'a une fréquence élevé (2h00 au lieu de 5mn par exemple)

[ArchiSi]

En solution temporaire (qui convient pour l'instant) : il suffit de positionner la boite à liste sur 1 jour, et cliquer sur repeter. Ca devrait aller, je confirmerai dans deux jours

Cordialemebtr

[Oliv-]

en fait lors du declenchement du script lié à l'événement, il faut parcourir la collection
application.reminders et supprimer celui qui correspond à notre macro.

je n'ai plus le code sous la main