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

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.folderpat h

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" wrote in message
...
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

Ken,

Thanks for the reply. I got it working using the getfolderid to determine
the correct calendar.

Cheers,

Paul

"Ken Slovak - [MVP - Outlook]" wrote:

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.folderpat h

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" wrote in message
...
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

.

Would you please post the solution, how did you solved the problem.
-Thanks