[OL-2003] [Sources] changer le formulaire dans calendrier par VBA et associer un bouton

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
Sub ChangeMessageClass()
 
' dates limites pour la reprise des données
Datedebut = InputBox(" DATE DE DEBUT ? ", _
    "date de début", DateAdd("m", -1, Date))
 
'contrôle de la saisie des dates (bon format et renseignée)
If Not (TestValidDate(Datedebut)) Then
    MsgBox "traitement non effectué, date invalide, veuillez recommencer"
    Exit Sub
Else
    dateDEB = Datedebut
End If
 
 
datefin = InputBox("DATE DE FIN ? ", _
    "date de fin", Date)
 
'contrôle de la saisie des dates (bon format et renseignée)
If Not (TestValidDate(datefin)) Then
    MsgBox "traitement non effectué, date invalide, veuillez recommencer"
    Exit Sub
Else
    dateFN = DateAdd("d", 1, datefin)
End If
 
  Set objApply = Outlook.Application
  Set objNameSpace = objApply.GetNamespace("MAPI")
 
  Dim myAppointments As Outlook.Items
 
    Set myAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar).Items
    myAppointments.Sort "[Start]"
    myAppointments.IncludeRecurrences = True
    Set objCalendrier = myAppointments.Find("[Start] >= """ & dateDEB & """ and [Start] < """ & dateFN & """")
 
    While TypeName(objCalendrier) <> "Nothing"
            If objCalendrier.MessageClass <> "IPM.Appointment.FormActivite" Then
                objCalendrier.MessageClass = "IPM.Appointment.FormActivite"
                objCalendrier.Save
            End If
        Set objCalendrier = myAppointments.FindNext
    Wend
 
  MsgBox "Action terminée "
 
End Sub

puis dans ThisOutlookSessio :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Application_MAPILogonComplete()
'Occurs when a user has logged on
 
'crée une barre de commande temporaire avec un bouton de commande, à l'ouverture d'outlook
 
Dim tlbCustomBar As CommandBar
    Set tlbCustomBar = Application.ActiveExplorer.CommandBars.Add(Name:="Custom Applications", Position:=msoBarTop, _
    Temporary:=True)
    tlbCustomBar.Visible = True
 
 
Dim btn2 As CommandBarButton
Set btn2 = tlbCustomBar.Controls.Add(Type:=msoControlButton)
With btn2
    .OnAction = "ChangeMessageClass"
    .Caption = "NouveauFormulaire"
    .Style = msoButtonIconAndCaption
    .FaceId = 303
End With
End Sub