Where is the calendar located? Is it in a different PST file, a delegate
Exchange mailbox, an Exchange public folder or what?
Try this to get information to provide so someone can help you. Select the
desired folder and make sure it's showing in an Outlook folder view. In
Outlook use Alt+F11 to open the Outlook VBA project. Make sure the Immediate
window is showing and in that window type the following:
? application.activeexplorer.currentfolder.folderpath
Copy that information into another post and then someone can guide you as to
how to get a handle to that folder.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007.
Reminder Manager, Extended Reminders, Attachment Options.
http://www.slovaktech.com/products.htm
"Paul" <(E-Mail Removed)> wrote in message
news:AF88FBD8-2D24-4884-98E3-(E-Mail Removed)...
> Hi,
>
> I'm using access 2003
>
> I'm looking for some code to create appointments into a shared outlook
> calendar.
>
> We've got several shared calendars and I need to post appointments into a
> specific one using dates and times from our access database.
>
> I've got the following code, but this puts the appointments in my personal
> calendar;
>
> I can't figure out how to modify this code to make it work for me,
>
> Anyone any ideas?
>
> Cheers,
>
> Paul
>
> 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!ApptStartDate & " " & Me!ApptTime
> .Duration = Me!ApptLength
> .AllDayEvent = True
> .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
Similar Threads
