PDA

View Full Version : Add an appointment to a collegues calender



wmr
09-23-2015, 05:47 AM
Hello,

For planning purposes, I want to add an appointment to the calender of a colleque.

So it is not my appointment, but his. So I can't use a meeting request, because I am not the organizer of the meeting.

My planning is in Excel. My colleque use his company Outlook and also a stand alone version on his home computer.

Does someone know?

thanks!

Kind regards
Willem

wmr
09-24-2015, 01:25 AM
I received the next code from someone. It does work in his file, but he don't understand the code. In my file it is not working and I don't understand why not.

I am using Excel 2010 and Outlook 2010 and sometimes 2013 of both.

Who does understand the code?

Kind regards
Willem


Private Sub Button1_Click()

Dim strMsg As String
Dim strName As String

Select Case Me![xxx]
Case "xx1"
strName = "email1"
Case "xx2"
strName = "email2"
End Select


' Start Outlook.
' If it is already running, you'll use the same instance...
Set objApp = CreateObject("Outlook.Application")

' Logon. Doesn't hurt if you are already running and logged on...
Set objNs = objApp.GetNamespace("MAPI")

' Create a new appointment.

Set objDummy = objApp.CreateItem(olAppointmentItem)
Set objRecip = objDummy.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
On Error Resume Next
Set objFolder = objNs.GetSharedDefaultFolder(objRecip, 9)
If Not objFolder Is Nothing Then
Set objAppt = objFolder.Items.Add
If Not objAppt Is Nothing Then
With objAppt
.Start = [date] + [time]
.Duration = 60
.Subject = [subject]
.Location = [location]
.ReminderSet = False
End With
End If
End If
Else
MsgBox "Could not find " & Chr(34) & strName & Chr(34), , _
"User not found"
End If

' Save Appointment...
objAppt.Save

' Clean up...
MsgBox "De afspraak is aangemaakt in de agenda.", vbMsgBoxSetForeground
objNs.Logoff
Set objNs = Nothing
Set objAppt = Nothing
Set objDummy = Nothing
Set objApp = Nothing
Set objFolder = Nothing
Set objRecip = Nothing

End Sub