K
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.
Keith
==================
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)
objRecip.Resolve
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
.Save
End With
End If
End If
Else
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
==================
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.
Keith
==================
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)
objRecip.Resolve
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
.Save
End With
End If
End If
Else
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
==================