Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
How To add Appointments on Exchange Server?
- Thread starter essnrv
- Start date
The program has to run on a client PC with Outlook 97 or later. Can use the Outlook object model.
When the app automates Outlook it will be logged onto Exchange Server as the current user on the local PC, the target users will need to grant permissions to their calendar folders for the users who can create appointments.
The strategy is to create a recipient object for the target user, pass it to GetSharedDefaultFolder to return the calendar folder then create the appointment item. Here's an outline:
Paul Bent
Northwind IT Systems
When the app automates Outlook it will be logged onto Exchange Server as the current user on the local PC, the target users will need to grant permissions to their calendar folders for the users who can create appointments.
The strategy is to create a recipient object for the target user, pass it to GetSharedDefaultFolder to return the calendar folder then create the appointment item. Here's an outline:
Code:
Set objOLApp = CreateObject("Outlook.Application")
Set objNS = objOLApp.GetNamespace("MAPI")
strUser = "Bloggs, Fred"
Set objRecip = objNS.CreateRecipient(strUser)
objRecip.Resolve
Set objFolder = objNS.GetSharedDefaultFolder( _
objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add
With objAppt
'Set the appointment properties here
.Save
End WithNorthwind IT Systems
- Thread starter
- #3
Which version of Outlook. What's the error number? Please post your code and indicate on which line the error occurs.
Paul Bent
Northwind IT Systems
Paul Bent
Northwind IT Systems
- Thread starter
- #5
Hi paulbent,
Thank you for your responses.
Version: Microsoft Outlook 97
Set objOutlook = CreateObject("Outlook.Application"
Set ObjNameSpace = objOutlook.GetNamespace("MAPI"
Set objUser = ObjNameSpace.CreateRecipient(smUser)
Set objFolder = ObjNameSpace.GetSharedDefaultFolder(objUser, olFolderCalendar)
Set objItem = objFolder.Items
'Delete All previous appointments
For Each Item In objItem
If InStr(Item.Body, "BART" > 0 Then blnpDelete = True
If blnpDelete Then Item.Delete
Next
'Add New appointments
Set objAppItem = objOutlook.CreateItem(olAppointmentItem)
With objAppItem
.Start = CDate(spStartTime)
.End = CDate(spEndTime)
.Subject = UCase(spSubject)
.Body = UCase(spBody)
'.CreationTime = Now
.Save
End With
'Clear the memory
Set objAppItem = Nothing
Set objFolder = Nothing
Set objItem = Nothing
Set ObjNameSpace = Nothing
Set objUser = Nothing
Set objOutlook = Nothing
Set Item = Nothing
Thanks in advance
Thank you for your responses.
Version: Microsoft Outlook 97
Set objOutlook = CreateObject("Outlook.Application"
Set ObjNameSpace = objOutlook.GetNamespace("MAPI"
Set objUser = ObjNameSpace.CreateRecipient(smUser)
Set objFolder = ObjNameSpace.GetSharedDefaultFolder(objUser, olFolderCalendar)
Set objItem = objFolder.Items
'Delete All previous appointments
For Each Item In objItem
If InStr(Item.Body, "BART"
> 0 Then blnpDelete = TrueIf blnpDelete Then Item.Delete
Next
'Add New appointments
Set objAppItem = objOutlook.CreateItem(olAppointmentItem)
With objAppItem
.Start = CDate(spStartTime)
.End = CDate(spEndTime)
.Subject = UCase(spSubject)
.Body = UCase(spBody)
'.CreationTime = Now
.Save
End With
'Clear the memory
Set objAppItem = Nothing
Set objFolder = Nothing
Set objItem = Nothing
Set ObjNameSpace = Nothing
Set objUser = Nothing
Set objOutlook = Nothing
Set Item = Nothing
Thanks in advance
OK but what's the error number and which line of code does it occur on?
The code is deleting appointments in a shared folder and creating an appointment in the user's own calendar folder. Is that what's intended?
Paul Bent
Northwind IT Systems
The code is deleting appointments in a shared folder and creating an appointment in the user's own calendar folder. Is that what's intended?
Paul Bent
Northwind IT Systems
- Thread starter
- #7
CreateItem will create an appointment item for the current user. See the code I posted originally which uses the Add method of the Items collection of the shared folder to create the appointment item in the shared folder.
Since you won't tell us which version of Outlook, the error number or which line it occurs on, I'm unable to research the issue further.
Paul Bent
Northwind IT Systems
Since you won't tell us which version of Outlook, the error number or which line it occurs on, I'm unable to research the issue further.
Paul Bent
Northwind IT Systems
- Thread starter
- #9
I am Sorry for not posting required information.
we are using Microsoft Outlook 97 (MSOUTL8.OLB). I am getting Error at below line
Set objFolder = ObjNameSpace.GetSharedDefaultFolder(objUser, olFolderCalendar)
Thank you for your quick responses
we are using Microsoft Outlook 97 (MSOUTL8.OLB). I am getting Error at below line
Set objFolder = ObjNameSpace.GetSharedDefaultFolder(objUser, olFolderCalendar)
Thank you for your quick responses
GetSharedDefaultFolder is supported by OL97 according to my documentation but I don't have an OL97 system these days to test with.
The only thing I can see in your code is that you haven't resolved the recipient per the code example I posted originally.
Are you sure that the target user has granted the necessary permissions to the calendar folder for the user running your app?
If you'd post the error number I can try and research it further.
Paul Bent
Northwind IT Systems
The only thing I can see in your code is that you haven't resolved the recipient per the code example I posted originally.
Are you sure that the target user has granted the necessary permissions to the calendar folder for the user running your app?
If you'd post the error number I can try and research it further.
Paul Bent
Northwind IT Systems
- Thread starter
- #11
There's nothing in the KB relating to this error number and GetSharedDefaultFolder. I've no idea what the problem is, I know it works fine in OL98 and later from my own programming.
Did you resolve the recipient before passing it to GetSharedDefaultFolder?
Have you tested if a user can open another user's calendar folder manually in Outlook and add an appointment without error?
Paul Bent
Northwind IT Systems
Did you resolve the recipient before passing it to GetSharedDefaultFolder?
Have you tested if a user can open another user's calendar folder manually in Outlook and add an appointment without error?
Paul Bent
Northwind IT Systems
Here's a little function I ran across, Hope it helps
Function OutlookAppointment(sAttendees As String, sSubject As String, dtStart As Date, lDuration As Long, lReminder As Long sLocation As String, bRecurrence As Boolean) As String
Dim oAppointment As Outlook.AppointmentItem
Dim oRecurrence As Outlook.RecurrencePattern
Dim oOutlook As Outlook.Application
Dim asAttendees() As String, lThisAttendee As Long
Dim oFolder As MAPIFolder
Dim oItems As Items
' Start Outlook
' If it is already running, you'll use the same instance...
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application"
' Logon. Doesn't hurt if you are already running and logged on...
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI"
olNs.Logon
Set oOutlook = New Outlook.Application
Set oAppointment = Outlook.CreateItem(olAppointmentItem)
'Set meeting parameters>
With oAppointment
.Duration = lDuration '(in minutes)
.Location = sLocation
.MeetingStatus = olMeeting
.Start = dtStart
.Subject = sSubject
.BusyStatus = olBusy
'.RecurrenceState
.ReminderSet = True
.ReminderMinutesBeforeStart = lReminder '(in Minutes)
End With
oAppointment.Save
'Add attendees
asAttendees = Split(sAttendees, ","
For lThisAttendee = 0 To UBound(asAttendees)
With oAppointment.Recipients.Add(asAttendees(lThisAttendee))
.Type = 1 '1 = Required, 2 = Optional
End With
Next
oAppointment.Recipients.Add (sAttendees)
'Send the appointment>
oAppointment.Send
Set olApp = Nothing
Set olNs = Nothing
Set oAppointment = Nothing
Set oOutlook = Nothing
Set oRecurrence = Nothing
End Function
Persistence....Nothing in the world can take the place of persistence. Talent will not; nothing is more common than unsuccessful men with talent. Genius will not; unrewarded genius is almost a proverb. Education will not; the world is full of educated derelicts. Persistence and determination alone are omnipotent. -Calvin Coolidge
Function OutlookAppointment(sAttendees As String, sSubject As String, dtStart As Date, lDuration As Long, lReminder As Long sLocation As String, bRecurrence As Boolean) As String
Dim oAppointment As Outlook.AppointmentItem
Dim oRecurrence As Outlook.RecurrencePattern
Dim oOutlook As Outlook.Application
Dim asAttendees() As String, lThisAttendee As Long
Dim oFolder As MAPIFolder
Dim oItems As Items
' Start Outlook
' If it is already running, you'll use the same instance...
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application"
' Logon. Doesn't hurt if you are already running and logged on...
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI"
olNs.Logon
Set oOutlook = New Outlook.Application
Set oAppointment = Outlook.CreateItem(olAppointmentItem)
'Set meeting parameters>
With oAppointment
.Duration = lDuration '(in minutes)
.Location = sLocation
.MeetingStatus = olMeeting
.Start = dtStart
.Subject = sSubject
.BusyStatus = olBusy
'.RecurrenceState
.ReminderSet = True
.ReminderMinutesBeforeStart = lReminder '(in Minutes)
End With
oAppointment.Save
'Add attendees
asAttendees = Split(sAttendees, ","
For lThisAttendee = 0 To UBound(asAttendees)
With oAppointment.Recipients.Add(asAttendees(lThisAttendee))
.Type = 1 '1 = Required, 2 = Optional
End With
Next
oAppointment.Recipients.Add (sAttendees)
'Send the appointment>
oAppointment.Send
Set olApp = Nothing
Set olNs = Nothing
Set oAppointment = Nothing
Set oOutlook = Nothing
Set oRecurrence = Nothing
End Function
Persistence....Nothing in the world can take the place of persistence. Talent will not; nothing is more common than unsuccessful men with talent. Genius will not; unrewarded genius is almost a proverb. Education will not; the world is full of educated derelicts. Persistence and determination alone are omnipotent. -Calvin Coolidge
- Status
