none
Adding an appointment to a shared calendar? RRS feed

  • Question

  • Hey all,

    I'm trying to write a program that will accept data and create a calendar appointment out of it. I have it working for my own calendar, but I can't figure out how to get it working for a shared calendar.  Here is the code:

     

    Public Class LoanerBlackberryAssistant
    
        Private Sub btnEnterDate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnterDate.Click
    
            'Starts Outlook
            Dim olApp As Outlook.Application
            olApp = CreateObject("Outlook.Application")
    
            'Gets NameSpace and Logon
            Dim olNs As Outlook.NameSpace
            olNs = olApp.GetNamespace("MAPI")
            olNs.Logon()
    
            Dim strUserName As String
            Dim strBlackberryNumber As String
            Dim strAssignmentDate As String
            Dim strExpectedReturnDate As String
    
            strUserName = Me.txtUserName.Text
            strBlackberryNumber = Me.txtBlackberryNumber.Text
            strAssignmentDate = Me.txtAssignmentDate.Text
            strExpectedReturnDate = Me.txtExpectedReturnDate.Text
    
            ' Prepare an appointment
            Dim oApp As Outlook.Application = New Outlook.Application()
    
            ' Create a new AppointmentItem.
            Dim oAppt As Outlook.AppointmentItem = oApp.CreateItem(Outlook.OlItemType.olAppointmentItem)
    
    
            ' Set some common properties.
            oAppt.Subject = strUserName
            oAppt.Body = strUserName
            oAppt.Location = strBlackberryNumber
    
            oAppt.Start = Convert.ToDateTime(strAssignmentDate)
            oAppt.End = Convert.ToDateTime(strExpectedReturnDate)
            oAppt.ReminderSet = True
            oAppt.ReminderMinutesBeforeStart = 5
            oAppt.BusyStatus = Outlook.OlBusyStatus.olBusy
            oAppt.IsOnlineMeeting = False
    
            ' Save to Calendar.
            oAppt.Save()
    
            ' Clean up.
            oApp = Nothing
            oAppt = Nothing
    
        End Sub
    

    Thanks for any help

     

     

    Wednesday, January 18, 2012 2:30 PM

Answers

  • The Appointment is being created in your Calendar because you aren't actually using the Folder you are getting with the GetDefaultSharedFolder method.  Instead of Application.CreateItem, use oAppt = Items.Add("IPM.Appointment").  You can get an Items collection from the Folder object returned from GetDefaultSharedFolder.
    Eric Legault
    MVP (Outlook)
    About me...
    • Marked as answer by unclepickle1 Friday, January 20, 2012 6:59 PM
    Friday, January 20, 2012 6:11 PM
    Moderator

All replies

  • Hello 

    There are not many active in this forum (daily) which use the .Net office Add Ins

    You are waiting currently 17 hours.

    As your problem is not how to use VB, but how to use the special part of Outlook I advice you to use the VSTO forum which is for the Visual Office Tools in Visual Studio, it is also for VB Net.

    http://social.msdn.microsoft.com/Forums/en-US/vsto

     


    Success
    Cor
    Thursday, January 19, 2012 7:06 AM
  • Hey all,

    I'm trying to write a program that will accept data and create a calendar appointment out of it. I have it working for my own calendar, but I can't figure out how to get it working for a shared calendar.  Here is the code:

    Public Class LoanerBlackberryAssistant
    
        Private Sub btnEnterDate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnterDate.Click
    
            'Starts Outlook
            Dim olApp As Outlook.Application
            olApp = CreateObject("Outlook.Application")
    
            'Gets NameSpace and Logon
            Dim olNs As Outlook.NameSpace
            olNs = olApp.GetNamespace("MAPI")
            olNs.Logon()
    
            Dim strUserName As String
            Dim strBlackberryNumber As String
            Dim strAssignmentDate As String
            Dim strExpectedReturnDate As String
    
            strUserName = Me.txtUserName.Text
            strBlackberryNumber = Me.txtBlackberryNumber.Text
            strAssignmentDate = Me.txtAssignmentDate.Text
            strExpectedReturnDate = Me.txtExpectedReturnDate.Text
    
            ' Prepare an appointment
            Dim oApp As Outlook.Application = New Outlook.Application()
    
            ' Create a new AppointmentItem.
            Dim oAppt As Outlook.AppointmentItem = oApp.CreateItem(Outlook.OlItemType.olAppointmentItem)
    
    
            ' Set some common properties.
            oAppt.Subject = strUserName
            oAppt.Body = strUserName
            oAppt.Location = strBlackberryNumber
    
            oAppt.Start = Convert.ToDateTime(strAssignmentDate)
            oAppt.End = Convert.ToDateTime(strExpectedReturnDate)
            oAppt.ReminderSet = True
            oAppt.ReminderMinutesBeforeStart = 5
            oAppt.BusyStatus = Outlook.OlBusyStatus.olBusy
            oAppt.IsOnlineMeeting = False
    
            ' Save to Calendar.
            oAppt.Save()
    
            ' Clean up.
            oApp = Nothing
            oAppt = Nothing
    
        End Sub
    
    

    Thanks for any help

    Thursday, January 19, 2012 2:57 PM
  • You need to use this method:

    NameSpace.OpenSharedFolder Method (Outlook):
    http://msdn.microsoft.com/en-us/library/ff867648.aspx

    To find out what the web address is for any given Internet Calendar that you already have linked in Outlook, go to the Account Settings dialog and click the Change button for the calendar in the Internet Calendars tab; you'll see the address listed in the location section.


    Eric Legault
    MVP (Outlook)
    About me...
    Thursday, January 19, 2012 3:19 PM
    Moderator
  • Thank you, but I'm not trying to set it to an Internet calendar, I'm trying to set it to a shared calendar on an Exchange server. 

    I get the error "LoanerCalendar.ics is not a valid Internet Calendar file."

    Thursday, January 19, 2012 7:11 PM
  • So, I don't know why I assumed it was a web calendar.  Use GetSharedDefaultFolder then:

    NameSpace.GetSharedDefaultFolder Method (Outlook):
    http://msdn.microsoft.com/en-us/library/ff869575.aspx


    Eric Legault
    MVP (Outlook)
    About me...
    Thursday, January 19, 2012 8:07 PM
    Moderator
  • That seems to be getting me closer to my goal, but this part of the code doesn't work.

     

    If myRecipient.Resolved Then 
     
     Call ShowCalendar(myNamespace, myRecipient) 
     
     End If 
    
    

     

    It doesn't seem to recognize ShowCalendar as a procedure.
    Friday, January 20, 2012 2:17 PM
  • Sorry UnclePickle, but it's impossible to know what's really going on there unless you show all of your code.  However, it's best if you just step through the code in debug mode so you can see exactly where it's failing and why (and try compiling as well to see if any errors are thrown).  Make sure to add proper error handling as well.
    Eric Legault
    MVP (Outlook)
    About me...
    Friday, January 20, 2012 4:32 PM
    Moderator
  • Here is the code.  There are no compile errors, it just adds the appointment to my default calendar instead of the user's.  The user's name is "Loaner Calendar."

    Public Class LoanerBlackberryAssistant
    
        Private Sub btnEnterDate_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEnterDate.Click
    
            Dim strUserName As String
            Dim strBlackberryNumber As String
            Dim strAssignmentDate As String
            Dim strExpectedReturnDate As String
    
            Dim oNamespace As Outlook.NameSpace
            Dim oFolder As Outlook.Folder
            Dim oRecipient As Outlook.Recipient
    
            ' Open Outlook
            Dim oApp As Outlook.Application = New Outlook.Application()
    
            ' Create a new AppointmentItem.
            Dim oAppt As Outlook.AppointmentItem = oApp.CreateItem(Outlook.OlItemType.olAppointmentItem)
    
            
    
            strUserName = Me.txtUserName.Text
            strBlackberryNumber = Me.txtBlackberryNumber.Text
            strAssignmentDate = Me.txtAssignmentDate.Text
            strExpectedReturnDate = Me.txtExpectedReturnDate.Text
    
    
    
            oNamespace = oApp.GetNamespace("MAPI")
            oRecipient = oNamespace.CreateRecipient("Loaner Calendar")
    
            oRecipient.Resolve()
    
    
            oFolder = oNamespace.GetSharedDefaultFolder(oRecipient, Outlook.OlDefaultFolders.olFolderCalendar)
    
            ' Set some common properties.
            oAppt.Subject = strUserName
            oAppt.Body = strUserName
            oAppt.Location = strBlackberryNumber
    
            oAppt.Start = Convert.ToDateTime(strAssignmentDate)
            oAppt.End = Convert.ToDateTime(strExpectedReturnDate)
            oAppt.ReminderSet = True
            oAppt.ReminderMinutesBeforeStart = 5
            oAppt.BusyStatus = Outlook.OlBusyStatus.olBusy
            oAppt.IsOnlineMeeting = False
    
            ' Save to Calendar.
            oAppt.Save()
    
            ' Clean up.
            oApp = Nothing
            oAppt = Nothing
    
        End Sub
    

     


    Friday, January 20, 2012 5:37 PM
  • The Appointment is being created in your Calendar because you aren't actually using the Folder you are getting with the GetDefaultSharedFolder method.  Instead of Application.CreateItem, use oAppt = Items.Add("IPM.Appointment").  You can get an Items collection from the Folder object returned from GetDefaultSharedFolder.
    Eric Legault
    MVP (Outlook)
    About me...
    • Marked as answer by unclepickle1 Friday, January 20, 2012 6:59 PM
    Friday, January 20, 2012 6:11 PM
    Moderator
  • That did it!

    Thanks a lot Eric.

    Friday, January 20, 2012 6:59 PM
  • Can you post your final code? I am having the same issue.
    Thursday, January 30, 2014 7:45 PM
  • Got it...

    Private Sub SetOutlookAppt()
            Try
                Dim mApplication As Outlook.Application
                mApplication = New Outlook.Application
                Dim mFolder As Outlook.MAPIFolder
                Dim mCalendarName As String = "TDM Unit"
                Dim mNS As Outlook.NameSpace
                Dim mCalendarRecip As Outlook.Recipient

                mNS = mApplication.GetNamespace("MAPI")

                Dim mAppointment As Outlook.AppointmentItem
                mAppointment = mApplication.CreateItem(Outlook.OlItemType.olAppointmentItem)

                mCalendarRecip = mNS.CreateRecipient(mCalendarName)
                mCalendarRecip.Resolve()
                mFolder = mNS.GetSharedDefaultFolder(mCalendarRecip, Outlook.OlDefaultFolders.olFolderCalendar)

                mAppointment = mFolder.Items.Add("IPM.Appointment")

                For Each item As CalendarItemEntity In mCalendarItem.Entities
                    Dim mRecipient As Outlook.Recipient = mAppointment.Recipients.Add(item.Email)
                    mRecipient.Type = CType(Outlook.OlMeetingRecipientType.olRequired, Integer)
                Next

                With mAppointment

                    .MeetingStatus = Outlook.OlMeetingStatus.olMeeting
                    .Subject = "Voices Meeting Request"
                    .Location = mCalendarItem.Office
                    .Body = String.Format("{0} Meeting - ID {1} - Date {2}", mCalendarItem.Calendar.Name, mCalendarItem.ID, mCalendarItem.StartTime.ToShortDateString)
                    '.ReminderMinutesBeforeStart = 60 'Not sure if they want this
                    '.ReminderSet = True 'Not sure if they want this
                    .Start = mCalendarItem.StartTime
                    .End = mCalendarItem.EndTime

                End With

                If Not mAppointment.Recipients.ResolveAll Then
                    MessageBox.Show("One or more of the Invitees did not resolve in Outlook, please verify all email addresses before sending")
                End If

                mAppointment.Save()
                mAppointment.Display()

            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try

        End Sub

    Thursday, January 30, 2014 8:07 PM
  • Hallelujah Eric! My solution, after twenty hours and finally stumbling onto yours, is:

    'Populates appointment in user's calendar, or shared calendar if supplied

    Dim AppOutlook As New outlook.Application
    Dim OLApt As outlook.AppointmentItem
    Dim objNS As outlook._NameSpace = AppOutlook.Session
    Dim objSharedFolder As Object
    Dim objSharedCal As outlook.MAPIFolder

    Dim strSharedEmail As String = "My Shared Folder" 'or user-supplied default, or blank

    Try
            If strSharedEmail <> "" Then
                  objSharedFolder = objNS.Folders(strSharedEmail).Folders("Calendar")
                  objSharedCal = CType(objSharedFolder, outlook.MAPIFolder)
                  OLApt = CType(objSharedCal.Items.Add("IPM.Appointment"), outlook.AppointmentItem)
            Else 'create in user's calendar
                  OLApt = CType(AppOutlook.CreateItem(outlook.OlItemType.olAppointmentItem),  _
                            outlook.AppointmentItem)
            End If
            'add OLApt attributes here.
            OLApt.Subject = "Some Subject" 'etc.
            OLApt.Save()
            OLApt.Display()
    Catch ex As Exception
             ' error message using ex.ToString
    Finally
            OLApt = Nothing
            AppOutlook = Nothing
    End Try

    Thursday, March 16, 2017 2:42 PM