Outlook 2010 VBS comment ajouter une réunion à un calendrier spécifique

Question

J'essaye de configurer un VBS pour créer une réunion dans un calendrier spécifique (pas par défaut) quand un bouton de commande est pressé. Le code que j'ai fonctionne mais crée la réunion dans le calendrier par défaut. J'ai essayé de tromper avec, mais je suis nouveau à VBS (principalement utilisé VBA). Je sais que VBA et VBS sont similaires, donc je suis sûr que quelque chose de petit doit être modifié. Je souhaite que les réunions soient placées dans un calendrier nommé Test, qui se trouve sous Mes calendriers.

Sub commandbutton1_Click() 

If CommandButton1 = False Then 
Dim objOL 'As Outlook.Application 
Dim objAppt 'As Outlook.AppointmentItem 

Const olAppointmentItem = 1 
Const olMeeting = 1 
Const olFree = 0 


Set objOL = CreateObject("Outlook.Application") 
Set objAppt = objOL.CreateItem(olAppointmentItem) 

objAppt.Subject = "My Test Appointment" 
objAppt.Start = #8/24/17 3:50:00 PM# 
objAppt.Duration = 1 
objAppt.Location = "Followup" 
objAppt.Body = "Test Verbiage" 
objAppt.ReminderMinutesBeforeStart = 1 
objAppt.BusyStatus = olFree 
objAppt.Save() 
Set objAppt = Nothing 
Set objOL = Nothing 

End If 


End Sub 

Answer 1

Essayez ceci:

Sub commandbutton1_Click() 

If CommandButton1 = False Then 

Const olAppointmentItem = 1 
Const olMeeting = 1 
Const olFree = 0 

Set objOutlook = CreateObject("Outlook.Application") 
Set objNamespace = objOutlook.GetNamespace("MAPI") 

Set objDictionary = CreateObject("Scripting.Dictionary") 

objDictionary.Add "August 24, 2017", "My Test Appointment" 


colKeys = objDictionary.Keys 

For Each strKey in colKeys 
dtmApptDate = strKey 
strApptName = objDictionary.Item(strKey) 

Set objAppt = objOutlook.CreateItem(olAppointmentItem) 
objAppt.Subject = strApptName 
objAppt.Start = dtmApptDate & " 3:50 PM" 
objAppt.Duration = 1 
objAppt.Location = "Followup" 
objAppt.Body = "Test Verbiage" 
objAppt.ReminderSet = True 
objAppt.ReminderMinutesBeforeStart = 1 
objAppt.AllDayEvent = True 
objAppt.BusyStatus = olFree 
objAppt.Save 
Next 


End If 


End Sub