Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Another utility to read msg files
Message
De
26/01/2015 16:21:48
 
 
À
26/01/2015 08:31:29
Information générale
Forum:
ASP.NET
Catégorie:
Autre
Versions des environnements
Environment:
VB 9.0
OS:
Windows 8.1
Network:
Windows 2008 Server
Database:
MS SQL Server
Application:
Web
Divers
Thread ID:
01614322
Message ID:
01614345
Vues:
25
It turns out that after a second verification, support confirmed they have support for RFC822 format text files (Outlook Express' .EML files). I have adjusted my class and it works well. For those who might interested, here is the ReadFromMSG class supporting nType=1 for RFC822 format text files (Outlook Express' .EML files) and nType=2 for Outlook binary.
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 = False
    Public nAttachment As Integer = 0
    Public nAttachmentToProcess As Integer = 0

    ' 1 - RFC822 format text files (Outlook Express' .EML files)
    ' 2 - Outlook binary
    Public nType As Integer = 1

    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
    Public 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 lcHeader As String = ""
        Dim llSaveAttachment As Boolean = True
        Dim lnLocation As Integer = 0
        Dim loAttachment As Independentsoft.Msg.Attachment = Nothing
        Dim loAttachmentExtensionAccepted As Object = Nothing
        Dim loAttachmentRFC822 As Independentsoft.Email.Mime.Attachment = Nothing
        Dim loAttachments As Independentsoft.Email.Mime.Attachment() = Nothing
        Dim loBodyPart As Independentsoft.Email.Mime.BodyPart = Nothing
        Dim loDirectoryFunction As DirectoryFunction = Nothing
        Dim loHeader As Independentsoft.Email.Mime.Header = Nothing
        Dim loInnerBodyPart As Independentsoft.Email.Mime.BodyPart = Nothing
        Dim loInnerBodyPart2 As Independentsoft.Email.Mime.BodyPart = Nothing
        Dim loMailbox As Independentsoft.Email.Mime.Mailbox = Nothing
        Dim loMessage As Independentsoft.Msg.Message = Nothing
        Dim loMessageRFC822 As Independentsoft.Email.Mime.Message = Nothing
        Dim loRecipient As Independentsoft.Msg.Recipient = Nothing

        ' Get the proper definition as per the current scope
        If oProcess Is Nothing Then
            loDirectoryFunction = New DirectoryFunction(oApp)
        Else
            loDirectoryFunction = New DirectoryFunction(oProcess)
        End If

        ' Reset the values
        cBody = ""
        cCC = ""
        cFileAttached = ""
        cFromAddress = ""
        cFromName = ""
        cHeader = ""
        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

        ' Based on the type
        Select Case nType

            ' RFC822 format text files (Outlook Express' .EML files)
            Case 1
                loMessageRFC822 = New Independentsoft.Email.Mime.Message(cFile)

                cFromAddress = loMessageRFC822.From.EmailAddress
                cFromName = loMessageRFC822.From.Name

                ' For each recipient
                For Each loMailbox In loMessageRFC822.To
                    cTo = oApp.AddToString(cTo, loMailbox.Name + " <" + loMailbox.EmailAddress + ">", "; ")
                Next

                ' For each recipient
                For Each loMailbox In loMessageRFC822.Cc
                    cCC = oApp.AddToString(cCC, loMailbox.Name + " <" + loMailbox.EmailAddress + ">", "; ")
                Next

                ' For each recipient
                For Each loMailbox In loMessageRFC822.ReplyTo
                    cReply = oApp.AddToString(cReply, loMailbox.Name + " <" + loMailbox.EmailAddress + ">", "; ")
                Next

                ' Subject
                cSubject = loMessageRFC822.Subject

                ' Sent
                dSent = loMessageRFC822.Date

                ' For each body part
                For Each loBodyPart In loMessageRFC822.BodyParts

                    ' If this is plain text
                    If loBodyPart.ContentType.Type = "text" And loBodyPart.ContentType.SubType = "plain" Then

                        ' Body
                        cBody = cBody + loBodyPart.Body

                    Else

                        ' If this is an Html email
                        If loBodyPart.ContentType.Type = "text" And loBodyPart.ContentType.SubType = "html" Then

                            ' Body
                            cBody = cBody + loBodyPart.Body

                            lHtml = True
                        End If

                    End If

                    ' For each inner body part
                    For Each loInnerBodyPart In loBodyPart.BodyParts

                        ' If this is plain text
                        If loInnerBodyPart.ContentType.Type = "text" And loInnerBodyPart.ContentType.SubType = "plain" Then

                            ' Body
                            cBody = cBody + loInnerBodyPart.Body

                        Else

                            ' If this is an Html email
                            If loInnerBodyPart.ContentType.Type = "text" And loInnerBodyPart.ContentType.SubType = "html" Then

                                ' Body
                                cBody = cBody + loInnerBodyPart.Body

                                lHtml = True
                            End If

                        End If

                        ' For each inner body part
                        For Each loInnerBodyPart2 In loInnerBodyPart.BodyParts

                            ' If this is plain text
                            If loInnerBodyPart2.ContentType.Type = "text" And loInnerBodyPart2.ContentType.SubType = "plain" Then

                                ' Body
                                cBody = cBody + loInnerBodyPart2.Body

                            Else

                                ' If this is an Html email
                                If loInnerBodyPart2.ContentType.Type = "text" And loInnerBodyPart2.ContentType.SubType = "html" Then

                                    ' Body
                                    cBody = cBody + loInnerBodyPart2.Body

                                    lHtml = True
                                End If

                            End If

                        Next

                    Next

                Next

                ' Get the attachments
                loAttachments = loMessageRFC822.GetAttachments

                ' Number of attachments
                nAttachment = loAttachments.Count

                ' For each attachment
                For Each loAttachmentRFC822 In loAttachments
                    lcFileName = loAttachmentRFC822.Name

                    ' 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, loAttachmentRFC822) 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

                            loAttachmentRFC822.Save(lcFileName, True)
                        End If

                    End If

                Next

                ' For each header
                For Each loHeader In loMessageRFC822.Headers
                    lcHeader = lcHeader + loHeader.Name + ": " + loHeader.Value + oApp.cCR
                Next

                ' Header
                cHeader = lcHeader

                ' Outlook binary
            Case 2
                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

        End Select

        ' Reset the values
        lSaveAttachment = False
        nType = 1

        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 collection
    ' expC1 Filename
    ' expC2 Attachment
    Private Function AddAttachment(ByVal tcFileName As String, ByVal toAttachment As Independentsoft.Email.Mime.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 loAttachmentRFC822 As Independentsoft.Email.Mime.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)

            ' Based on the type
            Select Case nType

                ' RFC822 format text files (Outlook Express' .EML files)
                Case 1
                    loAttachmentRFC822 = loObject(2)
                    loAttachmentRFC822.Save(cSaveAttachmentDirectory + lcFileName, True)

                    ' Outlook binary
                Case 2
                    loAttachment = loObject(2)
                    loAttachment.Save(cSaveAttachmentDirectory + lcFileName, True)

            End Select

        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 loAttachmentRFC822 As Independentsoft.Email.Mime.Attachment = Nothing
        Dim loObject As Object = Nothing

        ' Reset the values
        cMessage = ""

        loObject = oAttachment(nAttachmentToProcess)

        ' Initialization
        lcFileName = loObject(1)

        ' Based on the type
        Select nType

            ' RFC822 format text files (Outlook Express' .EML files)
            Case 1
                loAttachmentRFC822 = loObject(2)
                loAttachmentRFC822.Save(cSaveAttachmentDirectory + lcFileName, True)

                ' Outlook binary
            Case 2
                loAttachment = loObject(2)
                loAttachment.Save(cSaveAttachmentDirectory + lcFileName, True)

        End Select

        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
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform