Access and Public Folders in Outlook....

[samcamlou]

Hi,

If anyone can shed some light on what I am trying to do, it would be
appreacited.

What I am trying to do:

Trying to post a calender appointment into a "Public Folder" in outlook
form access97, I have tried the following code which create an item in
the default calender in my personal calender, how do I get the
appointment into my pubic calender "\Public folders\All Public
Folders\Staff Diary".

I have also tried stepping through using a MAPI and folder
references...but this is drining me mad!

Any advice....very welcome.

Rob Smith

Private Sub AddAppt_Click()


On Error GoTo AddAppt_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 already added to Microsoft
Outlook"
Exit Sub
' Add a new appointment.
Else
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Dim objItems As Outlook.Items
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
With outappt
.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
.Save
End With
End If
' Release the Outlook object variable.
Set outobj = Nothing
' Set the AddedToOutlook flag, save the record, display a
message.
Me!AddedtoOutlook = True
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"
Exit Sub
AddAppt_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub