Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Reading MSG files with MSG.NET
Message
De
24/01/2015 12:50:56
 
 
À
Tous
Information générale
Forum:
ASP.NET
Catégorie:
Autre
Titre:
Reading MSG files with MSG.NET
Versions des environnements
Environment:
VB 9.0
OS:
Windows 8.1
Network:
Windows 2008 Server
Database:
MS SQL Server
Application:
Web
Divers
Thread ID:
01614279
Message ID:
01614279
Vues:
55
Here is my updated ReadFromMSG class using MSG.NET. Pretty much 95% of it can be used as is with little adjustment to remove/replace what is framework specific.

The MSG.NET support is excellent. Rade is doing an excellent job with the email direct support.

This is their site if you ever need a .NET library that can read a MSG file (and even more as it reads pretty much out of Outlook), which you can use a class like this: http://www.independentsoft.de
Public Class ReadFromMSG

    Public cBody As String = ""
    Public cCC As String = ""
    Public cFile As String = ""
    Public cFileAttached As String = ""
    Public cFromAddress As String = ""
    Public cFromName As String = ""
    Public cHeader As String = ""
    Public cMessage As String = ""
    Public cReply As String = ""
    Public cSaveAttachmentDirectory As String = ""
    Public cSubject As String = ""
    Public cTo As String = ""
    Public dSent As Date = Nothing
    Public lAttachmentAcceptAllExtension As Boolean = True
    Public lHtml As Boolean = True
    Public lSaveAttachment As Boolean = True
    Public nAttachment As Integer = 0
    Public nAttachmentToProcess As Integer = 0
    Public oAttachment As Collection = New Collection
    Private cAddress As String = ""
    Private cFileAttachIsEmpty As String = ""
    Private cFileDoesNotExist As String = ""
    Private cName As String = ""
    Private nLanguage As Integer = 1
    Private oApp As App = Nothing
    Private oAttachmentExtensionAccepted As Collection = New Collection
    Private oProcess As LXProcess = Nothing

    ' This is when we access the class in a desktop mode
    Sub New(ByVal toApplication As App)
        oApp = toApplication
        nLanguage = oApp.nLanguage
        Init()
    End Sub

    ' This is when we access the class in a Web or Web Service mode
    Public Sub New(ByVal toProcess As LXProcess)
        oProcess = toProcess
        oApp = oProcess.oApp
        nLanguage = oProcess.nLanguage
        Init()
    End Sub

    ' Initialization
    Private Function Init() As Boolean

        ' Based on the language
        Select Case nLanguage

            ' English
            Case 1
                cFileAttachIsEmpty = "There are some attachments to this email but one of its file name is empty."
                cFileDoesNotExist = "The file does not exist."

                ' French
            Case 2
                cFileAttachIsEmpty = "Il y a des attachements à ce courriel mais un des fichiers contient un nom vide."
                cFileDoesNotExist = "Le fichier n'existe pas."

                ' Spanish
            Case 3
                cFileAttachIsEmpty = "There are some attachments to this email but one of its file name is empty."
                cFileDoesNotExist = "The file does not exist."

                ' Portuguese
            Case 4
                cFileAttachIsEmpty = "There are some attachments to this email but one of its file name is empty."
                cFileDoesNotExist = "The file does not exist."

        End Select

        Return True
    End Function

    ' Parse the MSG
    Public Function ParseMSG() As Boolean
        Dim lcExtension As String = ""
        Dim lcExtensionFound As String = ""
        Dim lcFileName As String = ""
        Dim llSaveAttachment As Boolean = True
        Dim lnLocation As Integer = 0
        Dim loAttachmentExtensionAccepted As Object = Nothing
        Dim loAttachment As Independentsoft.Msg.Attachment = Nothing
        Dim loDirectoryFunction As DirectoryFunction = New DirectoryFunction(oApp)
        Dim loMessage As Independentsoft.Msg.Message = Nothing
        Dim loRecipient As Independentsoft.Msg.Recipient = Nothing

        ' Reset the values
        cBody = ""
        cCC = ""
        cFileAttached = ""
        cFromAddress = ""
        cFromName = ""
        cMessage = ""
        cReply = ""
        cSubject = ""
        lHtml = True
        nAttachment = 0
        oAttachment.Clear()

        ' If the file does not exist
        If Not oApp.FileExist(cFile) Then
            cMessage = cFileDoesNotExist
            Return False
        End If

        loMessage = New Independentsoft.Msg.Message(cFile)

        cFromAddress = loMessage.SenderEmailAddress
        cFromName = loMessage.SenderName

        ' For each recipient
        For Each loRecipient In loMessage.Recipients

            ' Based on the type
            Select Case loRecipient.RecipientType

                ' To
                Case 0
                    cTo = oApp.AddToString(cTo, loRecipient.DisplayName + " <" + loRecipient.EmailAddress + ">", "; ")

                    ' CC
                Case 1
                    cCC = oApp.AddToString(cCC, loRecipient.DisplayName + " <" + loRecipient.EmailAddress + ">", "; ")

            End Select

        Next

        cReply = loMessage.ReplyTo

        ' Subject
        cSubject = loMessage.Subject

        ' Sent
        dSent = loMessage.MessageDeliveryTime

        ' Body
        cBody = loMessage.Body

        ' Number of attachments
        nAttachment = loMessage.Attachments.Count

        ' For each attachment
        For Each loAttachment In loMessage.Attachments
            lcFileName = loAttachment.FileName

            ' If we already had one before
            If cFileAttached.Length > 0 Then
                cFileAttached = cFileAttached + ", "
            End If

            cFileAttached = cFileAttached + lcFileName

            ' If the file name is empty
            If lcFileName.Length = 0 Then
                cMessage = cFileAttachIsEmpty
                Return False
            End If

            ' Add the attachment in the collection
            If Not AddAttachment(lcFileName, loAttachment) Then
                Return False
            End If

            llSaveAttachment = True

            ' If we do not accept all attachment extensions
            If Not lAttachmentAcceptAllExtension Then
                llSaveAttachment = False

                ' For each attachment extension accepted
                For Each loAttachmentExtensionAccepted In oAttachmentExtensionAccepted

                    ' Initialization
                    lcExtension = loAttachmentExtensionAccepted(1)

                    ' Get the last dot
                    lnLocation = oApp.RAt(".", lcFileName)

                    ' If we have found it
                    If lnLocation > 0 Then
                        lcExtensionFound = Mid(lcFileName, lnLocation + 1)

                        ' If the attachment extension is accepted
                        If UCase(lcExtension) = UCase(lcExtensionFound) Then
                            llSaveAttachment = True
                            Exit For
                        End If

                    End If

                Next

            End If

            ' If we save the attachment as per the class property
            If lSaveAttachment Then

                ' If we save the attacment as per the validation in this section
                If llSaveAttachment Then

                    ' If the directory does not exist
                    If Not oApp.DirectoryExist(cSaveAttachmentDirectory) Then

                        loDirectoryFunction.cDirectory = cSaveAttachmentDirectory
                        loDirectoryFunction.lLogError = False

                        ' If we cannot create the directory
                        If Not loDirectoryFunction.CreateDirectory() Then
                            cMessage = loDirectoryFunction.cMessage
                            Return False
                        End If

                    End If

                    loAttachment.Save(lcFileName, True)
                End If

            End If

        Next

        cBody = loMessage.BodyHtmlText

        ' If this is not a HTML email
        If loMessage.BodyHtmlText.Length = 0 Then
            lHtml = False
        End If

        ' Header
        cHeader = loMessage.TransportMessageHeaders

        Return True
    End Function

    ' Add an entry in the attachment collection
    ' expC1 Filename
    ' expC2 Attachment
    Private Function AddAttachment(ByVal tcFileName As String, ByVal toAttachment As Independentsoft.Msg.Attachment) As Boolean
        Dim loObject(2) As Object

        ' Initialization
        loObject(1) = tcFileName
        loObject(2) = toAttachment

        oAttachment.Add(loObject)

        Return True
    End Function

    ' Add an entry in the attachment extension accepted collection
    ' expC1 Extension
    Public Function AddAttachmentExtensionAccepted(ByVal tcExtension As String) As Boolean
        Dim loObject(1) As Object

        ' Initialization
        loObject(1) = tcExtension

        oAttachmentExtensionAccepted.Add(loObject)

        Return True
    End Function

    ' Save the attachments
    Public Function SaveAttachment() As Boolean
        Dim lcFileName As String = ""
        Dim loAttachment As Independentsoft.Msg.Attachment = Nothing
        Dim loDirectoryFunction As DirectoryFunction = New DirectoryFunction(oApp)
        Dim loObject As Object = Nothing

        ' Reset the values
        cMessage = ""

        ' If the directory does not exist
        If Not oApp.DirectoryExist(cSaveAttachmentDirectory) Then

            loDirectoryFunction.cDirectory = cSaveAttachmentDirectory
            loDirectoryFunction.lLogError = False

            ' If we cannot create the directory
            If Not loDirectoryFunction.CreateDirectory() Then
                cMessage = loDirectoryFunction.cMessage
                Return False
            End If

        End If

        ' For each attachment
        For Each loObject In oAttachment

            ' Initialization
            lcFileName = loObject(1)
            loAttachment = loObject(2)

            loAttachment.Save(cSaveAttachmentDirectory + lcFileName, True)
        Next

        Return True
    End Function

    ' Save the attachment from the application
    ' This allows the application to take action one file at a time
    Public Function SaveAttachmentFromTheApplication() As Boolean
        Dim lcFileName As String = ""
        Dim loAttachment As Independentsoft.Msg.Attachment = Nothing
        Dim loObject As Object = Nothing

        ' Reset the values
        cMessage = ""

        loObject = oAttachment(nAttachmentToProcess)

        ' Initialization
        lcFileName = loObject(1)
        loAttachment = loObject(2)

        loAttachment.Save(cSaveAttachmentDirectory + lcFileName, True)

        Return True
    End Function

End Class
Michel Fournier
Level Extreme Inc.
Designer, architect, owner of the Level Extreme Platform
Subscribe to the site at https://www.levelextreme.com/Home/DataEntry?Activator=55&NoStore=303
Subscription benefits https://www.levelextreme.com/Home/ViewPage?Activator=7&ID=52
Répondre
Fil
Voir

Click here to load this message in the networking platform