Running a Outlook VB.NET application without a session logged in

[RobinL]

Hi,

I am new to VB.NET and have written a simple application which accesses Outlook and saves email attachments to a folder, before deleting the emails.

This is requested from a scheduled task, it all works when I'm logged in as the user ( Called mailuser ).

Ideally I don't want to leave a session logged in, but when I try the application without a mailuser session logged in it doesn't seem to run to completion. It never saves any attachments and sometimes fails to close the application and Outlook.

The application is running under the correct user ( mailuser ), which is specified in the scheduled task.

Please could anybody explain how to set up the application to run without having to leave a session logged in ?

The code for the application is shown below :

Module Module1

    Sub Main()

        Dim objOL As Microsoft.Office.Interop.Outlook.Application
        Dim objNS As Microsoft.Office.Interop.Outlook.NameSpace
        Dim myItems As Microsoft.Office.Interop.Outlook.Items
        Dim x As Int16
        Dim styloEnv As New Stylo.Common.EnvironmentSettings
        Dim logFile As New Stylo.Common.LogFile
        Dim logName As String

        logName = logFile.GetNewLogFileName("MailUserExtractAttachments_", ".txt")
        logFile.WriteToLog(logName, Now.ToString & " - Start.")

        Try

            logFile.WriteToLog(logName, Now.ToString & " - Starting to get Outlook info")

            objOL = New Microsoft.Office.Interop.Outlook.Application()
            objNS = objOL.GetNamespace("MAPI")

            Dim olfolder As Microsoft.Office.Interop.Outlook.MAPIFolder
            Dim Atmt As Microsoft.Office.Interop.Outlook.Attachment

            logFile.WriteToLog(logName, Now.ToString & " - Attempting to log on to Outlook")

            objOL.GetNamespace("MAPI").Logon()

            logFile.WriteToLog(logName, Now.ToString & " - Logged on to Outlook")

            logFile.WriteToLog(logName, Now.ToString & " - Get Outlook Default Folder")

            olfolder = objOL.GetNamespace("MAPI").GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox)

            logFile.WriteToLog(logName, Now.ToString & " - Found default folder")

            myItems = olfolder.Items

            Dim y = myItems.Count
            x = 1
            logFile.WriteToLog(logName, Now.ToString & " - No Items - " & y)

            While x <= y

                logFile.WriteToLog(logName, Now.ToString & " - Found email from - " & myItems.Item(x).SenderEmailAddress)
                logFile.WriteToLog(logName, Now.ToString & " - Email contains   - " & myItems.Item(x).Subject)

                For Each Atmt In myItems.Item(x).attachments

                    Dim currDate As Date
                    Dim formattedStamp As String

                    currDate = Now

                    formattedStamp = currDate.Year.ToString("0000") & _
                                     currDate.Month.ToString("00") & _
                                     currDate.Day.ToString("00") & _
                                     "_" & _
                                     currDate.Hour.ToString("00") & _
                                     currDate.Minute.ToString("00") & _
                                     currDate.Second.ToString("00") & _
                                     currDate.Millisecond.ToString("000")

                    Dim filename = "G:\MailUserAttachments\" + Atmt.FileName + "_" + formattedStamp
                    Atmt.SaveAsFile(filename)
                    logFile.WriteToLog(logName, Now.ToString & " - Saving attachment - " & Atmt.FileName)
                    logFile.WriteToLog(logName, Now.ToString & " - As                - " & filename)
                Next Atmt

                myItems(x).delete()

                olfolder = objOL.GetNamespace("MAPI").GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderInbox)
                myItems = olfolder.Items
                y = myItems.Count

                x = 1

                objOL.GetNamespace("MAPI").Logoff()

            End While

        Catch ex As Exception
            logFile.WriteToLog(logName, Now.ToString & " - " & ex.Message)
            logFile.WriteToLog(logName, Now.ToString & " - Aborting.")
            Environment.Exit(1)
        End Try

    End Sub

End Module

Thanks

Robin

 

[Strini]

The simple way to make your application interact seamlessly with Outlook is to use the Redemption.dll Library.

This link has the DLL file (in the sample code download):
CodeProject: Backing up MS Outlook emails along with Meta-data. Free source code and programming help

The DLL has to be registered in Windows then referenced and lastly imported into your project.

Code Sample:

Imports System.Runtime.InteropServices.Marshal
Imports Redemption
Imports System.IO

Public Class clsEmailProcessor

    Friend Structure MailItem
        Dim MailItemId As String
        Dim ReceivedTime As String
        Dim SenderName As String
        Dim SenderAddress As String
        Dim Subject As String
        Dim MessageBody As String
        Dim Attachment() As String
        Dim AttachmentType() As String
    End Structure

    Friend LogFile As New clsFileWriteData
    Friend ItemCount As Int32 = 0
    Friend MailItemData(ItemCount) As MailItem

    Public Sub mainCode(ByVal SavePath As String)

        'Create New Mail session
        Dim MyMail As New RDOSession

        'Logon to Outlook
        MyMail.Logon("Outlook", "", False, False)

        'Dimension Inbox and Archive Folder
        Dim Inbox, ArchiveFolder As RDOFolder

        Try
            'Point to Default Inbox
            Inbox = MyMail.GetDefaultFolder(rdoDefaultFolders.olFolderInbox)

            'Create Archive folder if it does not exist
            Try
                ArchiveFolder = MyMail.GetFolderFromPath("Inbox\Archive")
            Catch ex As Exception
                ArchiveFolder = Inbox.Folders.Add("Archive")
            End Try

            'Dimension Email Message as Mail Items
            Dim Msgs As RDOItems = Inbox.Items

            'let Redemption know which properties we will be requesting later
            Msgs.MAPITable.Columns = "ReceivedTime, SenderName,SenderEmailAddress,Subject, Body"
            Msgs.MAPITable.Sort("ReceivedTime", False)

            If Msgs.Count > 0 Then

                For Each Msg In Msgs

                    Dim Attachments As RDOAttachments = Msg.Attachments

                    ReDim Preserve MailItemData(ItemCount)

                    MailItemData(ItemCount).MailItemId = CStr(Msg.EntryID)
                    MailItemData(ItemCount).ReceivedTime = Format(CDate(Msg.ReceivedTime), "yyyy-MM-dd hh:mm:ss")
                    MailItemData(ItemCount).SenderName = Replace(CStr(Msg.SenderName), "'", """", 1)
                    MailItemData(ItemCount).SenderAddress = Replace(CStr(Msg.SenderEmailAddress), "'", """", 1)
                    MailItemData(ItemCount).Subject = Replace(CStr(Msg.Subject), "'", """", 1)
                    MailItemData(ItemCount).MessageBody = Replace(CStr(Msg.Body), "'", """", 1)

                    If Attachments.Count > 0 Then

                        Dim AttachmentCount As Int32 = 0

                        For Each Attachment In Attachments

                            ReDim Preserve MailItemData(ItemCount).Attachment(AttachmentCount)
                            ReDim Preserve MailItemData(ItemCount).AttachmentType(AttachmentCount)

                            MailItemData(ItemCount).Attachment(AttachmentCount) = CStr(Attachment.FileName)
                            MailItemData(ItemCount).AttachmentType(AttachmentCount) = CStr(Attachment.Type)

                            If Not Directory.Exists(SavePath) Then
                                Directory.CreateDirectory(SavePath)
                            End If

                            If Not SavePath.EndsWith("\") Then
                                SavePath += "\"
                            End If

                            If MailItemData(ItemCount).AttachmentType(AttachmentCount) = "1" Then
                                Attachment.SaveAsFile(SavePath & Msg.EntryID & "_" & Attachment.FileName)
                            End If

                            AttachmentCount += 1

                        Next
                    End If

                    ItemCount += 1

                    Msg.markread(False)
                    Msg.move(ArchiveFolder)
                Next

            End If

        Catch ex As Exception
            LogFile.WriteToLogFile("Error while reading Emails", ex)
        End Try

        Inbox = Nothing
        MyMail.Logoff()
        MyMail = Nothing

    End Sub

End Class