Connecting to Calander in Public Folder

[MikeKohler]

Hi, I have used the following code to get an appointment into the main calendar in Outlook.
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

Set objOutlook = CreateObject("Outlook.Application&quot
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


.Save
.Close
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 Sub

Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
Exit Sub
My question, is how can I adjust this code so that I can send this information to a calander that exists in a public folder. I am designing a database for facility bookings, and need an individual calendar for each facility, to accomidate bookings for the same time. Any help will be appreciated.
Thank you, Michael Kohler
michael@slavelake.ca

 

[sodakotahusker]

Michael,
THis might not be much help but since no one else is answering your question, I'll pass this along.


I used this with Outlook to open up a customized form.
the objMyFolder seems to allow me to open the folder of my choice. (it has been 5 months since I played with this so it is not very fresh). Anyway perhaps this will give you clue? Good luck!
--------------------------------------


Set objMyItem = app.CreateItem(olMailItem)

Set objNameSpace = app.GetNamespace("MAPI&quot
objNameSpace.Logon "Don Parker", "DP2"
Set objMyFolder = objNameSpace.GetDefaultFolder(6)

Set objMyNewItem = objMyFolder.Items.Add("IPM.Note.myform&quot

 

[andytodd]

Hi Both,

I've got similar code writing multiple appointments into individual calendars, but have been so far - 12 months in trying on and off - unable to write to a public folder. It is possible to read in from a public folder quite easily.

Our short term solution is give the items a specific category - so we can find them quickly - and then ask the user to copy / move them by dragging it in outlook.

Andy Todd
a dot m dot todd at lboro dot ac dot uk

 

[MikeKohler]

Thanks for the responses, so Andy is possible to have multiple calendars in Outlook without using public folders?
-Mike

 

[MikeKohler]

Ok, I made some changes but I get an error,
"The Operation Failed. An Object could not be found"
But here is my code now

Dim ol As Outlook.Application
Dim olns As Outlook.NameSpace
Dim objAllFolders As MAPIFolder
Dim objFolder As MAPIFolder
Dim objAppt As Outlook.AppointmentItem
Dim i As Integer

'get the right folder
Set ol = Outlook.Application
Set olns = ol.GetNamespace("MapI&quot
Set objAllFolders = olns.Folders("All Public Folders&quot
Set objFolder = objAllFolders.Folders("NLC&quot

If Me!AddedToOutlook = True Then
MsgBox "This appointment is already added to Microsoft Outlook"
Exit Sub

'Add a new appointment
Else
Set objAppt = ol.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


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

Mike