add an appointment for a custom calendar, vba excel

  • Thread starter Thread starter Héctor Miguel
  • Start date Start date
H

Héctor Miguel

hi, all !

how is it possible (or should it be) to settle down an appointment in a custom calendar with vba ?

I have even ended up establishing a certain calendar as the current view in the OL browser
but the appointments always stay in the same calendar (the first one in the index or the original ?)
and I have not been able to find some article, topic, conversation that friendly explain this type of procedures (vba)

at the end is one of the used codes (up tp date) using late binding (just in case of several versions)

tia,
hector.

Sub Date_myCalendar()
Dim myOutlook As Object, myAppointment As Object, nRow As Integer, LRow As Integer
LRow = Range("a65536").End(xlUp).Row
On Error GoTo Create
Set myOutlook = GetObject(, "outlook.application")
If Err = 0 Then GoTo Created
Create:
Err.Clear
Set myOutlook = CreateObject("outlook.application")
Created:
On Error GoTo 0
For nRow = 2 To LRow
' in col-B are the calendar names
Set myOutlook.ActiveExplorer.CurrentFolder = _
myOutlook.Session.GetDefaultFolder(9).Folders.Item(Range("b" & nRow).Text)
Set myAppointment = myOutlook.CreateItem(1)
' in col-A are the appointment contract codes
myAppointment.Subject = "Contract code: " & Range("a" & nRow).Value
' in col-C are the dates for each appointment
myAppointment.Start = "09:00 am" & Format(Range("c" & nRow).Value, "mm/dd/yyyy")
myAppointment.End = "9:15 am" & Format(Range("c" & nRow).Value, "mm/dd/yyyy")
myAppointment.ReminderMinutesBeforeStart = 0 ' warning on appointment start
myAppointment.ReminderPlaySound = True
myAppointment.Save
Next
' myOutlook.Quit
Set myAppointment = Nothing
Set myOutlook = Nothing
End Sub
 
Using CreateItem() to create an item always adds that item to the default
folder for that type of item, not whichever folder is currently selected.

You can either create the item in the default folder and then move it to the
desired target folder, or you can get the target folder's Items collection
and call that collection's Add() method to add the item directly to that
target folder.
 
hi, Sir !

Thanks so much, Ken, that did the trick <vg>

regards,
hector.
Ken Slovak - [MVP - Outlook] wrote in message ...
Using CreateItem() to create an item always adds that item to the default folder for that type of item
not whichever folder is currently selected.

You can either create the item in the default folder and then move it to the desired target folder
or you can get the target folder's Items collection and call that collection's Add() method to add the item directly to that target folder.
hi, all !

how is it possible (or should it be) to settle down an appointment in a custom calendar with vba ?

I have even ended up establishing a certain calendar as the current view in the OL browser
but the appointments always stay in the same calendar (the first one in the index or the original ?)
and I have not been able to find some article, topic, conversation that friendly explain this type of procedures (vba)

at the end is one of the used codes (up tp date) using late binding (just in case of several versions)

tia,
hector.

Sub Date_myCalendar()
Dim myOutlook As Object, myAppointment As Object, nRow As Integer, LRow As Integer
LRow = Range("a65536").End(xlUp).Row
On Error GoTo Create
Set myOutlook = GetObject(, "outlook.application")
If Err = 0 Then GoTo Created
Create:
Err.Clear
Set myOutlook = CreateObject("outlook.application")
Created:
On Error GoTo 0
For nRow = 2 To LRow
' in col-B are the calendar names
Set myOutlook.ActiveExplorer.CurrentFolder = _
myOutlook.Session.GetDefaultFolder(9).Folders.Item(Range("b" & nRow).Text)
Set myAppointment = myOutlook.CreateItem(1)
' in col-A are the appointment contract codes
myAppointment.Subject = "Contract code: " & Range("a" & nRow).Value
' in col-C are the dates for each appointment
myAppointment.Start = "09:00 am" & Format(Range("c" & nRow).Value, "mm/dd/yyyy")
myAppointment.End = "9:15 am" & Format(Range("c" & nRow).Value, "mm/dd/yyyy")
myAppointment.ReminderMinutesBeforeStart = 0 ' warning on appointment start
myAppointment.ReminderPlaySound = True
myAppointment.Save
Next
' myOutlook.Quit
Set myAppointment = Nothing
Set myOutlook = Nothing
End Sub
 
Back
Top