Createitem() in Outlook on Microsoft Exchange

[driessen]

Hello,

I use "oOutlook:Createitem(1)" to create a new item in the calendar of Outlook.

The item is sended to the standard calender in Outlook.

But now I'm using Microsoft Exchange and I want to sent an item to a calendar which is not the standard calendar of the user, but a shared calender.

How can create a new item in a shared calender on a Microsoft Exchange server?

Thanks a lot in advance for any help.

[anserkk]

Here is a VB Code, which may be useful for you.

You can use the Namespace.GetSharedDefaultFolder method to access the Calendar folder in another Exchange mailbox. Keep in mind that you might not have permission to even see that folder, or you might have only read access.

Code: Select all  Expand view

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 person whose Calendar you want to use ###
    strName = "FlaviusJ"
     
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objDummy = objApp.CreateItem(olMailItem)
    Set objRecip = objDummy.Recipients.Add(strName)
    objRecip.Resolve
    If objRecip.Resolved Then
        On Error Resume Next
        Set objFolder = _
          objNS.GetSharedDefaultFolder(objRecip, _
            olFolderCalendar)
        If Not objFolder Is Nothing Then
            Set objAppt = objFolder.Items.Add
            If Not objAppt Is Nothing Then
                With objAppt
                    .Subject = "Test Appointment"
                    .Start = Date + 14
                    .AllDayEvent = True
                    .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

Regards
Anser

[driessen]

Thanks a lot, Anser.
I'm going to try it out.