Creating an appointment in outlook shared calendar using an access form (2 Viewers)

[Docko]

I have spent hours going through forums looking for an answer to this and cant seem to find one

I am looking at creating a form which allows you to select a person to create an appointment in their calendar in outlook. So far i have found a great programme which takes me step by step creating a form and the module to produce appointments but only in my own default calendar. I would like to add a selection to this to let me place the appointment in other peoples calendars.

I am using office 2007 and the other calendars(6) are shared.

Is this possible?

Any help would be greatly appreciated. Oh and i am a complete novice!! This is what i have:

The following example demonstrates how to create a form and a table to enter and store appointment information in a Microsoft Access database, and provides a sample Visual Basic for Applications procedure that uses Automation to add your appointments to Microsoft Outlook.

Start Microsoft Access and create a new database called Appt.mdb. Create the following new table in Design view:

Table: tblAppointments
Field Name: Appt Data
Type: Text
Field Size: 50
Required: Yes
Field Name: ApptDate
Data Type: Date/Time
Format: Short Date
Required: Yes
Field Name: ApptTime
Data Type: Date/Time
Format: Medium Time
Required: Yes
Field Name: ApptLength
Data Type: Number
Field Size: Long Integer
Default Value: 15
Required: Yes
Field Name: ApptNotes
Data Type: Memo
Field Name: ApptLocation
Data Type: Text
Field Size: 50
Field Name: ApptReminder
Data Type: Yes/No
Field Name: ReminderMinutes
Data Type: Number
Field Size: Long Integer
Default Value: 15
Field Name: AddedToOutlook
Data Type: Yes/No

Table Properties: tblAppointments
PrimaryKey: ApptDate;ApptTime

NOTE: In this example, the primary key in the appointment table is the appointment date and time. You can remove or alter the primary key if you want to be able to add multiple appointments for the same date and time. Create a reference to the Microsoft Outlook 8.0 Object Library. To do so, follow these steps:

1. Create a new module. On the Tools menu, click References. Click Microsoft Outlook 8.0 Object Library in the Available References box. If that reference does not appear, click Browse to locate the Msoutl8.olb file, which is installed by default in the C:\Program Files\Microsoft Office\Office folder. Click OK in the Reference dialog box.
2. Close the module without saving it.

1. Use the AutoForm: Columnar Form Wizard to create a new form based on the tblAppointments table. Save the form as frmAppointments.
2. Open the form in Design view and change the following properties: Form: frmAppointments
3. Caption: Appointment Form Form Header: Height: .5" Check Box: AddedToOutlook Enabled: No
   
4. Add a command button to the Form Header section, and set the following properties: Command Button: Name: AddAppt Caption: Send to Outlook OnClick: [Event Procedure]
   
5. Set the OnClick property of the command button to the following event procedure:

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
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

1. Save the form and open it in Form view. Add an appointment record, and then click the Send To Outlook button. Be sure you only enter minutes, not hours and minutes, in the ApptLength field.
2. Start Microsoft Outlook and click Calendar on the Go menu to view the appointments you added.

 

[darbid]

Hey what are you thinking/ or trying to do here. You want to put an apppointment item into another persons Outlook calendar? I assume you are in a Microsoft Exchange environment?

I think of appointments as a "2 or more" thing. You do it to bring 2 or more people together.

That said here are the options I would be thinking about. Following (I hope) your question if you have been given read/write access to the other person calendar as a shared calendar then you need to use the "getdefaultsharedfolder" and then create a new item from that. see here http://msdn.microsoft.com/en-us/library/bb219908%28office.12%29.aspx

Your other option is to create an .ics file and email them this. When the user clicks on this it will create the appointment which they then save.

 

[Docko]

Hi Darbid,

Thank you for taking the time to respond it is appreciated.

I am trying to create an appointment in another persons calendar but the tricky part is i want to choose between 5 people so it is not just the single person.

e.g if an appointment comes in for person 'a' i select them and the appointment goes to their calendar, if it's for person 'b' i select them and the appointment goes to their calendar.

What you have given me so far is great but it's only to one other specified calendar.

Any ideas on this?

Thanks again.

 

[darbid]

What you have given me so far is great but it's only to one other specified calendar.

My suggestion and what I have given you will work for anyone that has given you the rights to their calendar. Here is an example.

Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder 'get name of other persons folder
Dim objRecip As Outlook.Recipient 'other persons name
Dim strName As String 'the name or email of the persons folder
Dim objAppt As Outlook.AppointmentItem
Dim objApp As Outlook.Application


On Error Resume Next

[COLOR="Red"]' ### name of person whose Calendar you want to use ###[/COLOR]
strName = str_app_user

[COLOR="red"]'This example assume that the Outlook object is already alive.[/COLOR]

Set objNS = [COLOR="red"]objApp[/COLOR].GetNamespace("MAPI")

Set objRecip = objNS.CreateRecipient(strName)

Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)

If Not objFolder Is Nothing Then
    Set objAppt = objFolder.Items.Add
    
    If objAppt Is Nothing Then
        Set objAppt = objApp.CreateItem(olAppointmentItem)
    End If
    
    
Else
    MsgBox "no access to the folder meaning it is not shared"
End If


 
        With objAppt
            .Start = Format(Me.txt_start, "Short Date") & " " & Format(Me.txt_starttime, "Short Time")
            .End = Format(Me.txt_end, "Short Date") & " " & Format(Me.txt_endtime, "Short Time")
            .Location = Me.txt_location
            .Subject = Me.txt_subject
            .MeetingStatus = olMeeting
            .ReminderMinutesBeforeStart = 20
            .BusyStatus = olBusy
            .RequiredAttendees = Me.cbo_participants
            .Mileage = appointmentID
            .Recipients.ResolveAll
            

            .Save
            
            .display
            
            
 
        End With
        
        
        
        Set objNS = Nothing
Set objFolder = Nothing
Set objRecip = Nothing

Set objApp = Nothing

'dont forget to also set outlook to nothing.  Also do the Outlook object last.  Outlook will not close properly otherwise.

 

[Docko]

Hi Darbid,

Thanks again for your input. Another question Is their anyway i can change the lines below so that it will not go to a set person but will read the details from a field list on my form?

So if i was to select between person a,b,c,d or e and then click send to outlook it would send it to the person i had selected?

Sorry if i'm losing you here. i'm finding it hard to explain!!


Dim objFolder As Outlook.MAPIFolder 'get name of other persons folder
Dim objRecip As Outlook.Recipient 'other persons name
Dim strName As String 'the name or email of the persons folder

 

[darbid]

So if i was to select between person a,b,c,d or e and then click send to outlook it would send it to the person i had selected?

You need the email address of a,b,c,d etc.

Assuming "field_list_on_my_form" is the name of a control on your form with the email addres of the person for this specific appointment

[COLOR=Red]' ### name of person whose Calendar you want to use ###[/COLOR] 
strName = Me.ield_list_on_my_form.Value

 

[eacollie]

Hi,

I'm trying to do the same thing. I've got the appointment creation working, but need to go the other way now and allow the user to delete the appointment in Outlook. I'm not sure how to search for the matching appointment in Outlook.

Any help would be greatly appreciated!

Thanks

 

[darbid]

Hello eacollie, welcome to the forum.

Searching the forum now instead of google is your friend.

eg http://www.access-programmers.co.uk/forums/showthread.php?t=198640&highlight=mileage

 

[Docko]

Hi Darbid,

Thanks again. Because i am a novice i am struggling to get it to work. Would it be possible for you to post what the final program should look like?

Thanks agian for your help, your a star

 

[darbid]

A better way is you post your code and we will look at it together. That way you have the possibility of learning at the same time as you solve your problem.

 

[Docko]

This is what i have!!

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 objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set outappt = outobj.CreateItem(olAppointmentItem)
strName = Me!Assigned_to.Value
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

 

[darbid]

Great - now that code has not changed since your first post much.

Your code just creates an appointment with this line below, thus it creates it with outlook's default email address or yours.

[COLOR=#333333][FONT=Arial]Set outappt = outobj.CreateItem(olAppointmentItem)[/FONT][/COLOR]

So now look at my post #4.

What we need to do is to create an appointment for somebody else. So we have to go back one step and get their folder - if we are allowed to, then we add an appointment to this folder. This is the only step you are missing.

This is here

Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)

Once you know you are allowed to get the person folder then you add an appointment to it or set it if there is a problem.

Set objAppt = objFolder.Items.Add
Set objAppt = objApp.CreateItem(olAppointmentItem)

 

[Docko]

Ok so this is what i have now but an "error 424, object required" message comes up. Do you know what this means?

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 objFolder As Outlook.MAPIFolder
Dim objRecip As Outlook.Recipient
Dim strName As String
Dim outobj As Outlook.Application
Dim outappt As Outlook.AppointmentItem
Set outobj = CreateObject("outlook.application")
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add
Set objAppt = objApp.CreateItem(olAppointmentItem)
strName = Me!Assigned_to.Value
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

 

[darbid]

First you need to debug, then tell me which line is causing the error. Then compare it to my post 4. In my last post I did not give you cut and copy code.

 

[Docko]

Hi Darbid,

I think the code is all correct now. Now my problem is the message "no access to the folder meaning it is not shared" keeps coming up. I have set the user as a delegate and given editor permissions in the calendar. Do you know if their is anything else i need to do?

Thank you


Dim objNS As outlook.NameSpace
Dim objFolder As outlook.MAPIFolder 'get name of other persons folder
Dim objRecip As outlook.Recipient 'other persons name
Dim strName As String 'the name or email of the persons folder
Dim objAppt As outlook.AppointmentItem
Dim objApp As outlook.Application

On Error Resume Next
' ### name of person whose Calendar you want to use ###
strName = Me!Assigned_to.Value
'This example assume that the Outlook object is already alive.
Set objNS = objApp.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add

If objAppt Is Nothing Then
Set objAppt = objApp.CreateItem(olAppointmentItem)
End If


Else
MsgBox "no access to the folder meaning it is not shared"
End If


With objAppt
.Start = Me!ApptDate & " " & Me!ApptTime
.Duration = Me!ApptLength
.Subject = Me!Appt
.MeetingStatus = olMeeting
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
.BusyStatus = olBusy

.Save

.Display
End If


End With



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

 

[darbid]

The other person or the person with the email address in "Me!Assigned_to.Value" would have to go Tools > Options > Delegates and then add YOU in there and give you rights to their calendar.

 

[Docko]

I've done that but the same message keeps appearing! I've set the delegate to me and permissions to editor

 

[darbid]

can you manually see their calendar now in your outlook and can you make an appointment in their calendar from your outlook?

 

[Docko]

Yeah i can do that!

 

[darbid]

Ok then take your this from your code "On Error Resume Next" and tell me what errors your get?