Making an apt into a public calendar
 

Sorry, I'm new at this.....

I am programming MS Access can can make an outlook apt in the local
calendar, but I'd like to make an apt to the shared or public folder. How
do I specify in in which calendar I want the apt to be made?

Here's the code I use for the local computer:

On Error GoTo Add_Err
Dim intI As Integer
Dim dteStart As Date
Dim dteStop As Date
Dim intCounter As Integer
Dim intNoDays As Integer
dteStart = strStart
dteStop = strStop

'Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

'Add a new appointment.
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

.Categories = "SHOWS"
.AllDayEvent = True
'.Start = Me!ApptDate & " " & Me!ApptTime
.Start = strStart '& " 08:00 AM" 'Me!CallBack & " " & "09:00 AM"

'.End = strStop
'.Duration = Me!ApptLength
'.Subject = strSubject '"Call " & Me!Name & "-Prospect"
.Subject = strSubject
'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
' .PatternStartDate = #7/9/2003#
' 'You could get these values
' 'from new text boxes on the form.
' .PatternEndDate = #7/23/2003#
'End With

.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
'End If

'Release the Outlook object variable.
Set objOutlook = Nothing

'Set the AddedToOutlook flag, save the record, display a message.
'Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
'MsgBox "Appointment Added!"

Exit Function

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Function


Thanks!

Making an apt into a public calendar
 

To create an item in a particular folder, use the Add method on the target folder's Items collection:

Set newItem = targetFolder.Items.Add("IPM.Appointment.YourFormNa me")

optionally passing the name of a published form as the parameter.

To get a non-default folder, you need to walk the folder hierarchy using the Folders collections or use a function that does that for you. See http://www.outlookcode.com/d/code/getfolder.htm and, especially for public folders, http://www.outlookcode.com/codedetail.aspx?id=1164
--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003
http://www.turtleflock.com/olconfig/index.htm
and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
http://www.outlookcode.com/jumpstart.aspx


"SAC" wrote in message ...
Sorry, I'm new at this.....

I am programming MS Access can can make an outlook apt in the local
calendar, but I'd like to make an apt to the shared or public folder. How
do I specify in in which calendar I want the apt to be made?

Here's the code I use for the local computer:

On Error GoTo Add_Err
Dim intI As Integer
Dim dteStart As Date
Dim dteStop As Date
Dim intCounter As Integer
Dim intNoDays As Integer
dteStart = strStart
dteStop = strStop

'Save record first to be sure required fields are filled.
DoCmd.RunCommand acCmdSaveRecord

'Add a new appointment.
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

.Categories = "SHOWS"
.AllDayEvent = True
'.Start = Me!ApptDate & " " & Me!ApptTime
.Start = strStart '& " 08:00 AM" 'Me!CallBack & " " & "09:00 AM"

'.End = strStop
'.Duration = Me!ApptLength
'.Subject = strSubject '"Call " & Me!Name & "-Prospect"
.Subject = strSubject
'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
' .PatternStartDate = #7/9/2003#
' 'You could get these values
' 'from new text boxes on the form.
' .PatternEndDate = #7/23/2003#
'End With

.Save
.Close (olSave)
End With
'Release the AppointmentItem object variable.
Set objAppt = Nothing
'End If

'Release the Outlook object variable.
Set objOutlook = Nothing

'Set the AddedToOutlook flag, save the record, display a message.
'Me!AddedToOutlook = True
DoCmd.RunCommand acCmdSaveRecord
'MsgBox "Appointment Added!"

Exit Function

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Function


Thanks!