Read Outlook Calendar with Outlook Redemption.dll 

This does not close COM object and fails

Module Module1

    Sub Main()

        Dim dictColors As New Dictionary(Of String, Integer)

        If True Then

            Dim RDOSession As New Redemption.RDOSession

            'Dim Session As Redemption.RDOSession = CreateObject("Redemption.RDOSession")

            RDOSession.Logon("Outlook")

            'Set RDOFolder = RDOSession.GetDefaultFolder(olFolderInbox)

            Dim RDOFolder As Redemption.RDOFolder

            'RDOFolder = RDOSession.GetFolderFromPath("\\RichLemmermann@crouse.org\MedSurg Infusions\Calendar")

            RDOFolder = RDOSession.GetFolderFromPath("\\MedSurg Infusions\Calendar")

            'RDOFolder = RDOSession.GetDefaultFolder(rdoDefaultFolders.olFolderInbox)

            'RDOSession.Stores.FindExchangePublicFoldersStore()

            REM crousescripts_AoC::crousescripts_AoC5551212

            Dim RDOItems As Redemption.RDOItems

            RDOItems = RDOFolder.Items

            REM RDOItems.Sort "ReceivedTime", True

            Console.WriteLine("Count: " & RDOItems.Count)

            'console.writeline funWriteText(sFileName,"Count: " & RDOItems.Count)

            If RDOItems.Count > 0 Then

                For Each oItem In RDOItems

                    'Console.WriteLine("> " & oItem)

                    Dim oMail As Redemption.RDOAppointmentItem 'rdomail

                    oMail = RDOSession.GetMessageFromID(oItem.EntryID)

                    'Console.WriteLine(oMail.Start.ToShortDateString & " = " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " and  " & oMail.Start.ToShortDateString & " >= " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " And " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " <= " & oMail.End.ToShortDateString)

                    'Console.WriteLine(oMail.Start.ToShortDateString & " >= " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " And " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " <= " & oMail.End.ToShortDateString)

                    'Console.WriteLine(oMail.Start.ToShortDateString & " = " & Now.ToShortDateString)

                    Dim bProcess As Boolean = False

                    If oMail.IsRecurring Then

                        If oMail.Start.ToShortDateString <= DateAdd(DateInterval.Day, 0, Now).ToShortDateString And DateAdd(DateInterval.Day, 0, Now).ToShortDateString <= DateAdd(DateInterval.Minute, oMail.Duration, oMail.Start).ToShortDateString Then

                            'If oMail.Start.ToShortDateString <= DateAdd(DateInterval.Day, 0, Now).ToShortDateString And DateAdd(DateInterval.Day, 0, Now).ToShortDateString >= DateAdd(DateInterval.Minute, oMail.Duration, oMail.Start).ToShortDateString Then

                            'start  today  duration  end

                            Console.WriteLine("Recurring")

                            bProcess = True

                        End If

                        ' Console.WriteLine(vbTab & oMail.Subject.ToString & "," & oMail.Start.ToString & "," & oMail.End.ToString)

                    ElseIf oMail.Start.ToShortDateString = DateAdd(DateInterval.Day, 0, Now).ToShortDateString Or oMail.End.ToShortDateString = DateAdd(DateInterval.Day, 0, Now).ToShortDateString Then

                        bProcess = True

                        Console.WriteLine("Day of Day=Day")

                    ElseIf oMail.Start.ToShortDateString <= DateAdd(DateInterval.Day, 0, Now).ToShortDateString And DateAdd(DateInterval.Day, 0, Now).ToShortDateString <= oMail.End.ToShortDateString Then

                        Console.WriteLine("Day in between. Not recurring")

                        bProcess = True

                    End If

                    If bProcess Then

                        Dim sColor As String = ""

                        sColor = IIf(oMail.Categories Is Nothing, "NOTHING", "" & oMail.Categories)

                        Console.WriteLine(vbTab & oMail.Subject.ToString & "," & oMail.Start.ToString & "," & oMail.End.ToString)

                        'Console.WriteLine(oMail.Start.ToShortDateString & " = " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " and  " & oMail.Start.ToShortDateString & " >= " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " And " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " <= " & oMail.End.ToShortDateString)

                        'Debug.Print("here: " & oMail.Subject.ToString & " " & oMail.CreationTime.ToString & " " & oMail.SenderEmailAddress.ToString & " " & sColor)

                        'Console.WriteLine("" & oMail.Subject.ToString & " " & oMail.CreationTime.ToString & " " & IIf(oMail.Categories Is Nothing, "NOTHING", "COLOR: " & oMail.Categories))

                        'If dictColors(IIf(oMail.Categories Is Nothing, "NOTHING", "COLOR: " & oMail.Categories)) Then

                        If dictColors.ContainsKey(LCase(sColor)) Then

                            Dim dFind As KeyValuePair(Of String, Integer) = dictColors.First(Function(value As KeyValuePair(Of String, Integer)) value.Key.Equals(LCase(sColor)))

                            dictColors(dFind.Key) += 1

                        Else

                            dictColors.Add(LCase(sColor), 1)

                        End If

                    End If

                    'Codes.First(Function(S) S.Key.Equals(Key))

                    'If

                    'If oMail.Attachments.Count = 0 Then

                    '    If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, "email", oMail.SenderName, System.Text.Encoding.ASCII.GetBytes("No Attachments"), Encoding.ASCII.GetBytes(oMail.Body), Encoding.ASCII.GetBytes(oMail.HTMLBody))) Then

                    '        oMail.Delete()

                    '    End If ' funGetAttachStream

                    'End If

                    'For Each att In oMail.Attachments

                    '    Console.WriteLine("   Attach: " & att.filename)

                    '    'oMail.SaveAs("c:\temp\hi\" & att.filename)

                    '    Dim sBody As Byte()

                    '    Try

                    '        sBody = Encoding.ASCII.GetBytes(oMail.Body)

                    '    Catch ex As Exception

                    '        sBody = Encoding.ASCII.GetBytes(("Blank"))

                    '    End Try

                    '    Dim sBodyHTML As Byte()

                    '    Try

                    '        sBodyHTML = Encoding.ASCII.GetBytes(oMail.HTMLBody)

                    '    Catch ex As Exception

                    '        sBodyHTML = Encoding.ASCII.GetBytes("Blank")

                    '    End Try

                    '    If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, att.filename, oMail.SenderName, (att.asArray), sBody, sBodyHTML)) Then

                    '        oMail.Delete()

                    '    End If ' funGetAttachStream

                    '    ' System.Convert.ToBase64String(System.Text.Encoding.Unicode.GetBytes(att.AsText))

                    'Next

                Next

            End If

            If Err.Number <> 0 Then

                'call subSendEMail(cSourceEmail,"richlemmermann@crouse.org","richlemmermann@crouse.org","Error in code for eRX" & vbCrlf & sBody & err.description)

            End If

            RDOSession.Logoff()

        Else

            'For x As Integer = 1 To 15

            '    Console.WriteLine(funGetContents(x))

            'Next

        End If

        ' Console.WriteLine(vbCrLf & "Press ENTER")

        ' Console.ReadLine()

        Console.WriteLine("dictColors key count: " & dictColors.Keys.Count)

        For Each kP As KeyValuePair(Of String, Integer) In dictColors

            Console.WriteLine(Replace(Replace(kP.Key, ",", "|"), " category", "") & "," & kP.Value)

        Next

    End Sub

End Module

Read Outlook Categories (colors) from calendar

 Public Sub RunMe()
        Dim dictColors As New Dictionary(Of String, Integer)
        'Dim sFile = "\\crh16ftp01\FTPData\Cloverleaf\datatodss\prod\medsurgcolors.csv"
        Dim sFile = "\\crh16ftp01\FTPData\Cloverleaf\datatodss\prod\medsurgcolors.csv"
        WriteFile(Now & "," & "RunMe() start", sFileLog)


        Dim RDOSession As New Redemption.RDOSession
        'Dim Session As Redemption.RDOSession = CreateObject("Redemption.RDOSession")
        Try
            RDOSession.Logon("Outlook")
        Catch ex As Exception
            funSendMail("DailyCensusMedSurg_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "Cannot open Med Surg Infusions calendar", "on crh16vadvinstal. Running as a service" & vbCrLf & ex.Message.ToString, False)
            WriteFile(Now & "," & "cannot logon to outlook " & ex.Message, sFileLog)
        End Try


        'Set RDOFolder = RDOSession.GetDefaultFolder(olFolderInbox)

        Dim RDOFolder As Redemption.RDOFolder
        'RDOFolder = RDOSession.GetFolderFromPath("\\RichLemmermann@crouse.org\MedSurg Infusions\Calendar")
        Try
            RDOFolder = RDOSession.GetFolderFromPath("\\MedSurg Infusions\Calendar")
        Catch ex As Exception
            funSendMail("DailyCensusMedSurg_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "Error Retrieving MedSurg Infusions Calendar", "the actual GeetFolderFromPath" & vbCrLf & ex.Message.ToString, False)
            WriteFile(Now & "," & "cannot open folders " & ex.Message, sFileLog)
        End Try

        'RDOFolder = RDOSession.GetDefaultFolder(rdoDefaultFolders.olFolderInbox)
        'RDOSession.Stores.FindExchangePublicFoldersStore()

        REM crousescripts_AoC::crousescripts_AoC5551212
        Try
            Dim RDOItems As Redemption.RDOItems
            'RDOItems = RDOFolder.Items

            'RDOItems = RDOFolder.Items.Restrict("[StartDate] > '" & DateAdd(DateInterval.Month, -2, Now).ToShortDateString & "'")

            RDOItems = RDOFolder.Items.Restrict("SELECT * FROM Folder WHERE [ReceivedTime] > '" & DateAdd(DateInterval.Month, -2, Now).ToString("yyyy-MM-dd") & "' ORDER BY ReceivedTime")


            REM RDOItems.Sort "ReceivedTime", True

            Console.WriteLine("Count: " & RDOItems.Count)
            WriteFile(Now & "," & "Count: " & RDOItems.Count, sFileLog)
            WriteFile(Now & "," & " Estimated Finish (n/60s): " & (CDbl(RDOItems.Count) / 60), sFileLog)
            'console.writeline funWriteText(sFileName,"Count: " & RDOItems.Count)
            If RDOItems.Count > 0 Then
                For Each oItem In RDOItems
                    Try
                        'Console.WriteLine("> " & oItem)
                        Dim oMail As Redemption.RDOAppointmentItem 'rdomail
                        oMail = RDOSession.GetMessageFromID(oItem.EntryID)
                        'Console.WriteLine(oMail.Start.ToShortDateString & " = " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " and  " & oMail.Start.ToShortDateString & " >= " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " And " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " <= " & oMail.End.ToShortDateString)
                        'Console.WriteLine(oMail.Start.ToShortDateString & " >= " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " And " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " <= " & oMail.End.ToShortDateString)
                        'Console.WriteLine(oMail.Start.ToShortDateString & " = " & Now.ToShortDateString)
                        Dim bProcess As Boolean = False

                        If oMail.IsRecurring Then
                            If oMail.Start.ToShortDateString <= DateAdd(DateInterval.Day, 0, Now).ToShortDateString And DateAdd(DateInterval.Day, 0, Now).ToShortDateString <= DateAdd(DateInterval.Minute, oMail.Duration, oMail.Start).ToShortDateString Then
                                'If oMail.Start.ToShortDateString <= DateAdd(DateInterval.Day, 0, Now).ToShortDateString And DateAdd(DateInterval.Day, 0, Now).ToShortDateString >= DateAdd(DateInterval.Minute, oMail.Duration, oMail.Start).ToShortDateString Then
                                'start  today  duration  end
                                Console.WriteLine("Recurring")
                                WriteFile(Now & "," & "Recurring", sFileLog)
                                bProcess = True
                            End If
                            ' Console.WriteLine(vbTab & oMail.Subject.ToString & "," & oMail.Start.ToString & "," & oMail.End.ToString)
                        ElseIf oMail.Start.ToShortDateString = DateAdd(DateInterval.Day, 0, Now).ToShortDateString Or oMail.End.ToShortDateString = DateAdd(DateInterval.Day, 0, Now).ToShortDateString Then
                            bProcess = True
                            Console.WriteLine("Day of Day=Day")
                            WriteFile(Now & "," & "Day of Day=Day", sFileLog)
                        ElseIf oMail.Start.ToShortDateString <= DateAdd(DateInterval.Day, 0, Now).ToShortDateString And DateAdd(DateInterval.Day, 0, Now).ToShortDateString <= oMail.End.ToShortDateString Then
                            Console.WriteLine("Day in between. Not recurring")
                            bProcess = True
                        End If
                        If bProcess Then
                            Dim sColor As String = ""
                            Try
                                sColor = IIf(oMail.Categories Is Nothing, "NOTHING", "" & oMail.Categories)
                            Catch ex As Exception
                                Console.WriteLine("ERROR in sColor: " & ex.Message)
                                sColor = "NOTHING"
                            End Try
                            Try
                                Console.WriteLine(vbTab & oMail.Subject.ToString & "," & oMail.Start.ToString & "," & oMail.End.ToString)
                            Catch ex As Exception
                                Console.WriteLine("ERROR in printing out details: " & ex.Message)
                            End Try
                            'Console.WriteLine(oMail.Start.ToShortDateString & " = " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " and  " & oMail.Start.ToShortDateString & " >= " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " And " & DateAdd(DateInterval.Day, 0, Now).ToShortDateString & " <= " & oMail.End.ToShortDateString)
                            'Debug.Print("here: " & oMail.Subject.ToString & " " & oMail.CreationTime.ToString & " " & oMail.SenderEmailAddress.ToString & " " & sColor)
                            'Console.WriteLine("" & oMail.Subject.ToString & " " & oMail.CreationTime.ToString & " " & IIf(oMail.Categories Is Nothing, "NOTHING", "COLOR: " & oMail.Categories))
                            'If dictColors(IIf(oMail.Categories Is Nothing, "NOTHING", "COLOR: " & oMail.Categories)) Then
                            If dictColors.ContainsKey(LCase(sColor)) Then
                                Dim dFind As KeyValuePair(Of String, Integer) = dictColors.First(Function(value As KeyValuePair(Of String, Integer)) value.Key.Equals(LCase(sColor)))
                                dictColors(dFind.Key) += 1
                            Else
                                dictColors.Add(LCase(sColor), 1)
                            End If

                        End If


                        'WriteFile(Now & "," & "Release COM Object: oMail", sFileLogRelease)
                        Marshal.ReleaseComObject(oMail)
                        ' WriteFile(Now & "," & "Release COM Object: oItem", sFileLog)
                        oMail = Nothing
                        'Marshal.ReleaseComObject(oItem)


                        'Codes.First(Function(S) S.Key.Equals(Key))

                        'If
                        'If oMail.Attachments.Count = 0 Then
                        '    If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, "email", oMail.SenderName, System.Text.Encoding.ASCII.GetBytes("No Attachments"), Encoding.ASCII.GetBytes(oMail.Body), Encoding.ASCII.GetBytes(oMail.HTMLBody))) Then
                        '        oMail.Delete()
                        '    End If ' funGetAttachStream
                        'End If

                        'For Each att In oMail.Attachments
                        '    Console.WriteLine("   Attach: " & att.filename)
                        '    'oMail.SaveAs("c:\temp\hi\" & att.filename)
                        '    Dim sBody As Byte()
                        '    Try
                        '        sBody = Encoding.ASCII.GetBytes(oMail.Body)
                        '    Catch ex As Exception
                        '        sBody = Encoding.ASCII.GetBytes(("Blank"))
                        '    End Try


                        '    Dim sBodyHTML As Byte()

                        '    Try
                        '        sBodyHTML = Encoding.ASCII.GetBytes(oMail.HTMLBody)
                        '    Catch ex As Exception
                        '        sBodyHTML = Encoding.ASCII.GetBytes("Blank")
                        '    End Try

                        '    If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, att.filename, oMail.SenderName, (att.asArray), sBody, sBodyHTML)) Then
                        '        oMail.Delete()
                        '    End If ' funGetAttachStream
                        '    ' System.Convert.ToBase64String(System.Text.Encoding.Unicode.GetBytes(att.AsText))
                        'Next
                    Catch ex As Exception
                        WriteFile(Now & ", for each oItem: " & ex.Message, sFileLog)
                    End Try
                Next
            End If
            WriteFile(Now & "," & "Release COM Object: RDOFolder", sFileLog)
            Marshal.ReleaseComObject(RDOFolder)
            'WriteFile(Now & "," & "Release COM Object: RDOItems", sFileLog)
            Marshal.ReleaseComObject(RDOItems)
            RDOItems = Nothing
            RDOFolder = Nothing
        Catch ex As Exception
            funSendMail("DailyCensusMedSurg_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "Error in the body of retrieving the calendar items", ex.Message.ToString, False)
            WriteFile(Now & "," & "Error in the body of retrieving the calendar items: " & ex.Message.ToString, sFileLog)
        End Try


        If Err.Number <> 0 Then
            'call subSendEMail(cSourceEmail,"richlemmermann@crouse.org","richlemmermann@crouse.org","Error in code for eRX" & vbCrlf & sBody & err.description)  
        End If


        RDOSession.Logoff()
        WriteFile(Now & "," & "Logoff", sFileLog)
        WriteFile(Now & "," & "Release COM Object: RDOSession", sFileLog)

        Marshal.ReleaseComObject(RDOSession)

        ' WriteFile(Now & "," & "Garbage Collection Count: " & GC.WaitForFullGCComplete, sFileLog)
        WriteFile(Now & "," & "Garbage Collection Now ", sFileLog)
        GC.Collect()

        ' Else
        'For x As Integer = 1 To 15
        '    Console.WriteLine(funGetContents(x))
        'Next
        '  End If


        ' Console.WriteLine(vbCrLf & "Press ENTER")
        ' Console.ReadLine()
        'If My.Computer.FileSystem.FileExists(sFile) Then My.Computer.FileSystem.DeleteFile(sFile)
        Dim sContents As String = ""

        Console.WriteLine("dictColors key count: " & dictColors.Keys.Count)
        For Each kP As KeyValuePair(Of String, Integer) In dictColors
            Console.WriteLine(Replace(Replace(kP.Key, ",", "|"), " category", "") & "," & kP.Value)
            sContents = sContents & CDate(DateAdd(DateInterval.Day, 0, Now).ToShortDateString).ToString("MM/dd/yyyy") & "," & Replace(Replace(kP.Key, ",", "|"), " category", "") & "," & kP.Value & vbCrLf

        Next
        WriteFile(sContents, sFile, False)
        WriteFile(vbCrLf & Now & "," & vbCrLf & sContents, sFileLog)
        funSendMail("DailyCensusMedSurg_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "DailyCensusMedSurg (testing as service)", Now & vbCrLf & vbCrLf & sContents, False)


    End Sub

Read and process emails from Inbox

Public Sub RunMe()
        Dim dictColors As New Dictionary(Of String, Integer)
        'Dim sFile = "\\crh16ftp01\FTPData\Cloverleaf\datatodss\prod\medsurgcolors.csv"
        Dim sFile = "c:\temp\nada.csv"
        Dim sContents As String = ""

        WriteFile(Now & "," & "RunMe() start", sFileLog)


        Dim RDOSession As New Redemption.RDOSession
        'Dim Session As Redemption.RDOSession = CreateObject("Redemption.RDOSession")
        Try
            RDOSession.Logon("Outlook")
        Catch ex As Exception
            funSendMail("VarianceReports_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "Cannot open ADAutomation Calendar", "on crh16vadvinstal. Running as a service" & vbCrLf & ex.Message.ToString, False)
            WriteFile(Now & "," & "cannot logon to outlook " & ex.Message, sFileLog)
        End Try


        'Set RDOFolder = RDOSession.GetDefaultFolder(olFolderInbox)

        Dim RDOFolder As Redemption.RDOFolder
        'RDOFolder = RDOSession.GetFolderFromPath("\\RichLemmermann@crouse.org\MedSurg Infusions\Calendar")
        Try
            RDOFolder = RDOSession.GetDefaultFolder(Redemption.rdoDefaultFolders.olFolderInbox) '  .GetFolderFromPath("\\MedSurg Infusions\Calendar")
        Catch ex As Exception
            funSendMail("VarianceReports_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "Error Retrieving  ADAutomation Calendar ", "the actual GeetFolderFromPath" & vbCrLf & ex.Message.ToString, False)
            WriteFile(Now & "," & "cannot open folders " & ex.Message, sFileLog)
        End Try

        'RDOFolder = RDOSession.GetDefaultFolder(rdoDefaultFolders.olFolderInbox)
        'RDOSession.Stores.FindExchangePublicFoldersStore()

        REM crousescripts_AoC::crousescripts_AoC5551212
        Try
            Dim RDOItems As Redemption.RDOItems
            'RDOItems = RDOFolder.Items

            'RDOItems = RDOFolder.Items.Restrict("[StartDate] > '" & DateAdd(DateInterval.Month, -2, Now).ToShortDateString & "'")

            'RDOItems = RDOFolder.Items.Restrict("SELECT * FROM Folder WHERE [ReceivedTime] > '" & DateAdd(DateInterval.Month, -2, Now).ToString("yyyy-MM-dd") & "' ORDER BY ReceivedTime")
            'RTL
            'RDOFolder = RDOSession.GetFolderFromPath("\\adautomation@crouse.org\Inbox")

            REM RDOItems.Sort "ReceivedTime", True

            RDOItems = RDOFolder.Items

            Console.WriteLine("Count: " & RDOItems.Count)
            WriteFile(Now & "," & "Count: " & RDOItems.Count, sFileLog)
            WriteFile(Now & "," & " Estimated Finish (n/60s): " & (CDbl(RDOItems.Count) / 60), sFileLog)
            'console.writeline funWriteText(sFileName,"Count: " & RDOItems.Count)
            If RDOItems.Count > 0 Then
                For Each oItem In RDOItems
                    Try
                        Dim oMail As Redemption.RDOMail
                        oMail = RDOSession.GetMessageFromID(oItem.EntryID)
                        Console.WriteLine(vbTab & oMail.SenderName)
                        If InStr(oMail.Subject, "EPSI Report", CompareMethod.Text) > 0 Then
                            Console.WriteLine("Processing: " & Replace(Replace(oMail.Subject, "EPSI Report", ""), "'", ""))

                            If oMail.Attachments.Count = 0 Then
                                'If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, "email", oMail.SenderName, System.Text.Encoding.ASCII.GetBytes("No Attachments"), Encoding.ASCII.GetBytes(oMail.Body), Encoding.ASCII.GetBytes(oMail.HTMLBody))) Then
                                'oMail.Delete()
                                'End If ' funGetAttachStream
                            End If

                            For Each att In oMail.Attachments
                                Console.WriteLine("   Attach: " & att.filename)
                                'oMail.SaveAs("c:\temp\hi\" & att.filename)
                                Dim sBody As Byte()
                                Try
                                    sBody = Encoding.ASCII.GetBytes(oMail.Body)
                                Catch ex As Exception
                                    sBody = Encoding.ASCII.GetBytes(("Blank"))
                                End Try


                                Dim sBodyHTML As Byte()

                                Try
                                    sBodyHTML = Encoding.ASCII.GetBytes(oMail.HTMLBody)
                                Catch ex As Exception
                                    sBodyHTML = Encoding.ASCII.GetBytes("Blank")
                                End Try
                                Try
                                    My.Computer.FileSystem.WriteAllBytes("\\Cs3cnn01\dashboarddocs\EPSi\" & att.filename, att.asArray, False)
                                    Console.WriteLine("SUCCESSfully saved: " & "\\Cs3cnn01\dashboarddocs\EPSi\" & att.filename)
                                    WriteFile(Now & ",SUCCESSfully saved: " & "\\Cs3cnn01\dashboarddocs\EPSi\" & att.filename, sFileLog)
                                    sContents = sContents & "Success: " & att.filename & vbCrLf
                                    'RTL
                                    'oMail.Move(RDOSession.GetFolderFromPath("\\adautomation@crouse.org\Inbox\EPSi_Reports"))
                                    oMail.Move(RDOSession.GetFolderFromPath("Inbox\EPSi_Reports"))
                                Catch ex As Exception
                                    Console.WriteLine("File error: " & ex.Message.ToString)
                                    sContents = sContents & "File error: " & ex.Message & vbCrLf
                                    WriteFile(Now & ",File error: " & ex.Message, sFileLog)
                                End Try

                                'If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, att.filename, oMail.SenderName, (att.asArray), sBody, sBodyHTML)) Then
                                'oMail.Delete()
                                'End If ' funGetAttachStream
                                ' System.Convert.ToBase64String(System.Text.Encoding.Unicode.GetBytes(att.AsText))
                            Next
                        ElseIf InStr(oMail.Subject, "Crouse New Hires", CompareMethod.Text) > 0 Then
                            'RTL
                            'oMail.Move(RDOSession.GetFolderFromPath("\\adautomation@crouse.org\Inbox\Crouse New Hires"))
                            oMail.Move(RDOSession.GetFolderFromPath("Inbox\Crouse New Hires"))
                        ElseIf InStr(oMail.Subject, "CMP New Hires", CompareMethod.Text) > 0 Then
                            'RTL
                            'oMail.Move(RDOSession.GetFolderFromPath("\\adautomation@crouse.org\Inbox\CMP New Hires"))
                            oMail.Move(RDOSession.GetFolderFromPath("Inbox\CMP New Hires"))

                        End If


                        'WriteFile(Now & "," & "Release COM Object: oMail", sFileLogRelease)

                        Marshal.ReleaseComObject(oMail)
                        ' WriteFile(Now & "," & "Release COM Object: oItem", sFileLog)
                        oMail = Nothing
                        'Marshal.ReleaseComObject(oItem)


                        'Codes.First(Function(S) S.Key.Equals(Key))

                        'If
                        'If oMail.Attachments.Count = 0 Then
                        '    If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, "email", oMail.SenderName, System.Text.Encoding.ASCII.GetBytes("No Attachments"), Encoding.ASCII.GetBytes(oMail.Body), Encoding.ASCII.GetBytes(oMail.HTMLBody))) Then
                        '        oMail.Delete()
                        '    End If ' funGetAttachStream
                        'End If

                        'For Each att In oMail.Attachments
                        '    Console.WriteLine("   Attach: " & att.filename)
                        '    'oMail.SaveAs("c:\temp\hi\" & att.filename)
                        '    Dim sBody As Byte()
                        '    Try
                        '        sBody = Encoding.ASCII.GetBytes(oMail.Body)
                        '    Catch ex As Exception
                        '        sBody = Encoding.ASCII.GetBytes(("Blank"))
                        '    End Try


                        '    Dim sBodyHTML As Byte()

                        '    Try
                        '        sBodyHTML = Encoding.ASCII.GetBytes(oMail.HTMLBody)
                        '    Catch ex As Exception
                        '        sBodyHTML = Encoding.ASCII.GetBytes("Blank")
                        '    End Try

                        '    If (funInsertValue(oMail.Subject, oMail.ReceivedTime, oMail.Size, att.filename, oMail.SenderName, (att.asArray), sBody, sBodyHTML)) Then
                        '        oMail.Delete()
                        '    End If ' funGetAttachStream
                        '    ' System.Convert.ToBase64String(System.Text.Encoding.Unicode.GetBytes(att.AsText))
                        'Next
                    Catch ex As Exception
                        WriteFile(Now & ", for each oItem: " & ex.Message, sFileLog)
                        sContents = sContents & ", for each oItem: " & ex.Message & vbCrLf
                    End Try
                Next
            End If
            WriteFile(Now & "," & "Release COM Object: RDOItems", sFileLog)
            Marshal.ReleaseComObject(RDOItems)

            WriteFile(Now & "," & "Release COM Object: RDOFolder", sFileLog)
            Marshal.ReleaseComObject(RDOFolder)
            RDOItems = Nothing
            RDOFolder = Nothing
        Catch ex As Exception
            funSendMail("VarianceReports_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "Error in the body of retrieving the calendar items", ex.Message.ToString, False)
            WriteFile(Now & "," & "Error in the body of retrieving the  items: " & ex.Message.ToString, sFileLog)
            sContents = sContents & Now & "," & "Error in the body of retrieving the  items: " & ex.Message.ToString & vbCrLf
        End Try


        If Err.Number <> 0 Then
            'call subSendEMail(cSourceEmail,"richlemmermann@crouse.org","richlemmermann@crouse.org","Error in code for eRX" & vbCrlf & sBody & err.description)  
        End If


        RDOSession.Logoff()
        WriteFile(Now & "," & "Logoff", sFileLog)
        WriteFile(Now & "," & "Release COM Object: RDOSession", sFileLog)

        Marshal.ReleaseComObject(RDOSession)

        ' WriteFile(Now & "," & "Garbage Collection Count: " & GC.WaitForFullGCComplete, sFileLog)
        WriteFile(Now & "," & "Garbage Collection Now ", sFileLog)
        GC.Collect()

        ' Else
        'For x As Integer = 1 To 15
        '    Console.WriteLine(funGetContents(x))
        'Next
        '  End If


        ' Console.WriteLine(vbCrLf & "Press ENTER")
        ' Console.ReadLine()
        'If My.Computer.FileSystem.FileExists(sFile) Then My.Computer.FileSystem.DeleteFile(sFile)


        'Console.WriteLine("dictColors key count: " & dictColors.Keys.Count)
        'For Each kP As KeyValuePair(Of String, Integer) In dictColors
        '    Console.WriteLine(Replace(Replace(kP.Key, ",", "|"), " category", "") & "," & kP.Value)
        '    sContents = sContents & CDate(DateAdd(DateInterval.Day, 0, Now).ToShortDateString).ToString("MM/dd/yyyy") & "," & Replace(Replace(kP.Key, ",", "|"), " category", "") & "," & kP.Value & vbCrLf

        'Next
        'WriteFile(sContents, sFile, False)
        'WriteFile(vbCrLf & Now & "," & vbCrLf & sContents, sFileLog)
        funSendMail("VarianceReports_CRH16VADVINSTAL@crouse.org", "richlemmermann@crouse.org", "VarianceReports (testing as service)", Now & vbCrLf & vbCrLf & sContents, False)


    End Sub