Adding an entry to a Calendar in a shared public folder with VBA


Keith E.

I have a web application that stores vacation requests in
an Access database.
I would like to extend its functionality by adding a macro
to the Access DB that
would add the requests to a "Vacation Calander"
(alias: "VacationCalendar")
in a shared public folder in Outlook.

A subroutine that should do this is listed below. It works
great if the Calendar used
is an individual user's calendar. However, the following
line produces a "The server mailbox
cannot be opened because this address book entry is not an
e-mail user" error message, when the
"Vacation Calander" (alias: "VacationCalendar") in a
shared public folder in used.

Set objFolder = _
objNS.GetSharedDefaultFolder(objRecip, _
9) 'olFolderCalendar

The public folder has e-mail access enabled and appears in
the Outlook global address list.

Any insight would be appreciated.

Thanks in advance.


Sub CreateOtherUserAppointment()
Dim objApp As Outlook.Application
Dim objNS 'As Outlook.NameSpace
Dim objFolder 'As Outlook.MAPIFolder
Dim objDummy 'As Outlook.MailItem
Dim objRecip 'As Outlook.Recipient
Dim objAppt 'As Outlook.AppointmentItem
Dim strMsg 'As String
Dim strName 'As String
On Error Resume Next

' ### name of Calendar to use ###
strName = "VacationCalendar"

Set objApp = New Outlook.Application
Set objNS = objApp.GetNamespace("MAPI")
Set objDummy = objApp.CreateItem(0) 'olMailItem

Set objRecip = objDummy.Recipients.Add(strName)
If Not objRecip.Resolve Then myItem.Display
If objRecip.Resolved Then

On Error Resume Next
Set objFolder = _
objNS.GetSharedDefaultFolder(objRecip, _
9) 'olFolderCalendar
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
With objAppt
.Subject = "Test Appointment"
.Start = #4/21/2004 8:00:00 AM#
.End = #4/21/2004 4:00:00 PM#
.Location = Town & Gown
.BusyStatus = 1
.Body = "Stop the insanity.... "
.AllDayEvent = False
End With
End If
End If
MsgBox "Could not find " & Chr(34) & strName & Chr
(34), , _
"User not found"
End If

Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objDummy = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
End Sub



Sue Mosher [MVP-Outlook]

Please see my response to your earlier post in the
microsoft.public.outlook.program_vba group, which is the better forum for
programming questions.

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question