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 = str_app_user
'This example assume that the Outlook object is already there.
'see my above example to get the outlook object and then you add it here
Set objNS = objApp.GetNamespace("MAPI")
Set objRecip = objNS.CreateRecipient(strName)
'note that this uses GetSharedDefaultFolder which is a little bit more flexible cause you can then choose the calendar
'you can change this to GetDefaultFolder
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"
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.