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