Add appointment to calendar--NOT my default!

  • Thread starter Thread starter Clddleopard
  • Start date Start date
C

Clddleopard

So, I'm a cut and paster when it comes to VBA, and I was able to modify this
to use my tables to add to my default calendar. However, I don't want to add
to my default calendar. I want to add it to another of my calendars. Let's
call it calendar2.
What can I do to tell it to put an appointment in calendar2 instead of my
default calendar?
Private Sub cmdAddAppt_Click()
On Error GoTo Add_Err
'Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord
'Exit the procedure if appointment has been added to Outlook.
If Me!AddedToOutlook = True Then
MsgBox "This appointment is already added to Microsoft Outlook"
Exit Sub
'Add a new appointment.
Else
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim objRecurPattern As Outlook.RecurrencePattern
Set objOutlook = CreateObject("Outlook.Application")
Set objAppt = objOutlook.CreateItem(olAppointmentItem)
With objAppt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
If Not IsNull(Me!ApptNotes) Then .Body = Me!ApptNotes
If Not IsNull(Me!ApptLocation) Then .Location = Me!ApptLocation
If Me!ApptReminder Then
.ReminderMinutesBeforeStart = Me!ReminderMinutes
.ReminderSet = True
End If
Set objRecurPattern = .GetRecurrencePattern

With objRecurPattern
.RecurrenceType = olRecursWeekly
.Interval = 1
'Once per week
'You can hard-wire in these dates or get the
'information from text boxes, as used here.
'.PatternStartDate = #12/1/2003#
.PatternStartDate = Me!ApptStartDate
'.PatternEndDate = #12/30/2003#
.PatternEndDate = Me!ApptEndDate
End With
.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
End If
'Release the object variables.
Set objOutlook = Nothing
.....Set objRecurPattern = Nothing
'Set the AddedToOutlook flag, save the record, display
'a message.
Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub
 
Actually you piqued my curiosity...

From what I can tell, you'll have to either use the .PickFolder method of
the namespace object to select the folder manually or loop through the
folders collection and choose it by a If...Then. (see
http://msdn.microsoft.com/en-us/library/bb177014.aspx) If you use the
technique in the article, you'll need to supply the full path.

Once you've selected (or found) the folder, you'll need to set an object
reference to the folders Items collection. Once instantiated, you'll then use
the .Add method of the Items collection to create the new AppointmentItem. I
don't know why, but you'd think that I'd remember something funky like that.

So in short, you won't be able to copy and past it. I did a fair amount of
googling around.
 
Back
Top