Wednesday, September 25, 2019

OutLook and GetSharedDefaultFolder problem

Reading shared calenders like 'TestRig 1', 'TestRig 2', 'TestRig 3' using .GetSharedDefaultFolder() worked as a charm until
'TestRig 11' and 'Test Rig 12' where added 😢.

'TestRig11 and 12 you can find but not TestRig1 anymore, using 'TestRig 1' is almost same as 'TestRig 11' only the last char is new.

The Fix: 'TestRig 1' is a view name, so changing to the real mail address instead testrig1@mytestcenter.com and the problem was solved 😀


The Code:
-----------------------------------------------------------------------------------
Sub ReadCalendarFromOutlook(calName As String)
        Dim application As New Microsoft.Office.Interop.Outlook.Application

        Dim myNamespace As Outlook.NameSpace
        Dim myRecipient As Outlook.Recipient
        CalDay1.Scroll2Time(Now)
        CalDay1.SetupTimeLine()
        CalDay1.ClearAllEvents()
        lblCalInfo.Visible = False

        If calName = "" Then
            lblCalInfo.Visible = True
            lblCalInfo.Text = "No Calendar available"
            Exit Sub
        End If
        Try
            myNamespace = application.GetNamespace("MAPI")

            myRecipient = myNamespace.CreateRecipient(calName)

        Catch ex As Exception
            MsgBox("It looks like you are missing OutLook on the computer :(")
            Exit Sub
        End Try

        Try
            Dim folder As Outlook.Folder = DirectCast(application.Session.GetSharedDefaultFolder(myRecipient, Outlook.OlDefaultFolders.olFolderCalendar), Outlook.Folder)
            Dim todayAppointments As New List(Of Outlook.AppointmentItem)()

            ' ------------- Get Appointment for Date selected --------------------------------
            Dim query = From p In folder.Items.Cast(Of Outlook.AppointmentItem)() Where p.Start.[Date] = DateTimePicker1.Value.[Date]

            ' ------------- Get ReCurrent Appointment for Date selected --------------------------------
            Dim q1 As Outlook._AppointmentItem
            Dim query2 = From p In folder.Items.Cast(Of Outlook.AppointmentItem)()


            For Each q1 In query2

                If q1.IsRecurring Then
                    Dim aRecurrent As Outlook.RecurrencePattern = q1.GetRecurrencePattern
                    Dim dx As DateTime
                    ' dx = New DateTime(DateTimePicker1.Value.Year, DateTimePicker1.Value.Month, DateTimePicker1.Value.Day, q1.Start.Hour, q1.Start.Minute, 0)
                    dx = DateTimePicker1.Value.[Date] + q1.Start.[TimeOfDay]
                    Dim ap As Outlook.AppointmentItem = Nothing
                    Try
                        ' .GetOccurence() seems a bit strange, it returns ap=Nothing if a Appoinment is found ??? ELSE it returns a ComException
                        ap = aRecurrent.GetOccurrence(dx)
                        ' ap = nothing, so we found an appointment
                        CalDay1.AddEvent(DateTimePicker1.Value.[Date] + q1.Start.[TimeOfDay], DateTimePicker1.Value.[Date] + q1.End.[TimeOfDay], q1.Subject + vbCrLf + q1.Location)
                    Catch ex1 As System.Runtime.InteropServices.COMException
                        ' We end up here if appointment wasn't found for selected day
                        Debug.Print(ex1.Message)
                    Catch ex As Exception
                        Debug.Print(ex.Message)
                        End Try

                    Else
                        If q1.Start.[Date] = DateTimePicker1.Value.[Date] Then
                            CalDay1.AddEvent(q1.Start, q1.End, q1.Subject + vbCrLf + q1.Location)
                        End If
                    End If
                    q1 = Nothing
                Next


            Catch ex As Exception
            Debug.Print("Error: " + ex.Message)

            ' NB: If you got error msg "Outlook does not recognize one or more names"
            ' Then use CalName="TestRig1@testcenter.com instead of "TestRig 1"
            ' When we added TestRig11 and 12, using "TestRig 1" stopped working.
            
            lblCalInfo.Visible = True
                lblCalInfo.Text = "Failed to read Calendar" + vbCrLf + calName
            End Try

    End Sub





No comments:

MySQL to MariaDB

 Here is a good description how to migrate to MariaDb MySQL to MariaDb Example of how to dump data from MySQL port=3307: mysqldump --user=ro...