In previous section, I introduced how to verify digital signature and decrypt email. In this section, I will introduce how to parse winmail.dat (TNEF stream) in VB 6.0.
Sections:
When an Outlook user composes and sends a message using either Rich Text Format or HTML Format, Outlook automagically generates a file, winmail.dat, and attaches it to the end of the email. The winmail.dat contains the rich text body and original attachments. To parse winmail.dat (TNEF stream) file, we should use ParseTNEF method.
Note
Remarks: All of examples in this section are based on first section: A simple VB 6.0 project. To compile and run the following example codes successfully, please click here to learn how to create the test project and add reference to your project.
The following example codes demonstrate how to parse MAPI winmail.dat.
Note
To get the full sample projects, please refer to Samples section.
Option Explicit
Const CRYPT_MACHINE_KEYSET = 32
Const CRYPT_USER_KEYSET = 4096
Const CERT_SYSTEM_STORE_CURRENT_USER = 65536
Const CERT_SYSTEM_STORE_LOCAL_MACHINE = 131072
Private Sub ParseEmail(ByVal emlFile As String)
Dim oMail As New EAGetMailObjLib.Mail
oMail.LicenseCode = "TryIt"
On Error GoTo ErrorHandle
oMail.LoadFile emlFile, False
If oMail.IsEncrypted Then
' This email is encrypted, we decrypt it by user default certificate.
' You can also use specified certificate like this
' Dim oCert As New EAGetMailObjLib.Certificate
' oCert.LoadFromFile "c:\test.pfx", "pfxpassword", CRYPT_USER_KEYSET
' Set oMail = oMail.Decrypt(oCert)
Set oMail = oMail.Decrypt(Nothing)
End If
If oMail.IsSigned Then
' This email is digital signed.
Dim oCert As EAGetMailObjLib.Certificate
Set oCert = oMail.VerifySignature
MsgBox "This email contains a valid digital signature."
' You can add the certificate to your certificate storage like this
' oCert.AddToStore CERT_SYSTEM_STORE_CURRENT_USER, "addressbook"
' Then you can use send the encrypted email back to this sender.
End If
' Parse email sender
MsgBox "From: " & oMail.From.Address
Dim addressList As EAGetMailObjLib.AddressCollection
Dim i As Long
Dim addr As EAGetMailObjLib.MailAddress
' Parse email to recipients
Set addressList = oMail.ToList
For i = 0 To addressList.Count - 1
Set addr = addressList.Item(i)
MsgBox "To: " & addr.Address
Next
' Parse email cc
Set addressList = oMail.CcList
For i = 0 To addressList.Count - 1
Set addr = addressList.Item(i)
MsgBox "Cc: " & addr.Address
Next
' Parse email subject
MsgBox "Subject: " & oMail.Subject
' Parse email text body
MsgBox "Text body: " & oMail.TextBody
' Parse email HTML body
MsgBox "Html body: " & oMail.HtmlBody
' Parse attachments
Dim atts As EAGetMailObjLib.AttachmentCollection
Dim att As EAGetMailObjLib.Attachment
Set atts = oMail.AttachmentList
For i = 0 To atts.Count - 1
Set att = atts.Item(i)
MsgBox "Attachment: " & att.name
' This attachment is in OUTLOOK RTF format(TNEF), decode it here.
If LCase(att.name) = "winmail.dat" Then
Dim tatts
Dim x As Integer
tatts = oMail.ParseTNEF(att.Content, True)
For x = LBound(tatts) To UBound(tatts)
Dim tatt As EAGetMailObjLib.Attachment
Set tatt = tatts(x)
MsgBox "winmail.dat: " & tatt.name
Next
End If
Next
Exit Sub
ErrorHandle:
MsgBox Err.Description
End Sub
Private Sub Command1_Click()
Dim curpath As String
Dim mailbox As String
Dim oTools As New EAGetMailObjLib.Tools
' Create a folder named "inbox" under current directory
' to save the email retrieved.
curpath = App.Path
mailbox = curpath & "\inbox"
oTools.CreateFolder mailbox
Dim files
Dim i As Long
' Get all *.eml files in specified folder and parse it one by one.
files = oTools.GetFiles(mailbox & "\*.eml")
For i = LBound(files) To UBound(files)
ParseEmail files(i)
Next
Exit Sub
ErrorHandle:
MsgBox Err.Description
End Sub
In EAGetMail 4.5, a new method named DecodeTNEF is introduced. It is easier to parse TNEF attachment. Please have a look at the following example codes:
Option Explicit
Const CRYPT_MACHINE_KEYSET = 32
Const CRYPT_USER_KEYSET = 4096
Const CERT_SYSTEM_STORE_CURRENT_USER = 65536
Const CERT_SYSTEM_STORE_LOCAL_MACHINE = 131072
Private Sub ParseEmail(ByVal emlFile As String)
Dim oMail As New EAGetMailObjLib.Mail
oMail.LicenseCode = "TryIt"
On Error GoTo ErrorHandle
oMail.LoadFile emlFile, False
If oMail.IsEncrypted Then
' This email is encrypted, we decrypt it by user default certificate.
' You can also use specified certificate like this
' Dim oCert As New EAGetMailObjLib.Certificate
' oCert.LoadFromFile "c:\test.pfx", "pfxpassword", CRYPT_USER_KEYSET
' Set oMail = oMail.Decrypt(oCert)
Set oMail = oMail.Decrypt(Nothing)
End If
If oMail.IsSigned Then
' This email is digital signed.
Dim oCert As EAGetMailObjLib.Certificate
Set oCert = oMail.VerifySignature
MsgBox "This email contains a valid digital signature."
' You can add the certificate to your certificate storage like this
' oCert.AddToStore CERT_SYSTEM_STORE_CURRENT_USER, "addressbook"
' Then you can use send the encrypted email back to this sender.
End If
' Decode winmail.dat (TNEF) automatically'
oMail.DecodeTNEF
' Parse email sender
MsgBox "From: " & oMail.From.Address
Dim addressList As EAGetMailObjLib.AddressCollection
Dim i As Long
Dim addr As EAGetMailObjLib.MailAddress
' Parse email to recipients
Set addressList = oMail.ToList
For i = 0 To addressList.Count - 1
Set addr = addressList.Item(i)
MsgBox "To: " & addr.Address
Next
' Parse email cc
Set addressList = oMail.CcList
For i = 0 To addressList.Count - 1
Set addr = addressList.Item(i)
MsgBox "Cc: " & addr.Address
Next
' Parse email subject
MsgBox "Subject: " & oMail.Subject
' Parse email text body
MsgBox "Text body: " & oMail.TextBody
' Parse email HTML body
MsgBox "Html body: " & oMail.HtmlBody
' Parse attachments
Dim atts As EAGetMailObjLib.AttachmentCollection
Dim att As EAGetMailObjLib.Attachment
Set atts = oMail.AttachmentList
For i = 0 To atts.Count - 1
Set att = atts.Item(i)
MsgBox "Attachment: " & att.name
' Save attachment to local file.
att.SaveAs App.Path & "\inbox\" & att.name, true
Next
Exit Sub
ErrorHandle:
MsgBox Err.Description
End Sub
Private Sub Command1_Click()
Dim curpath As String
Dim mailbox As String
Dim oTools As New EAGetMailObjLib.Tools
' Create a folder named "inbox" under current directory
' to save the email retrieved.
curpath = App.Path
mailbox = curpath & "\inbox"
oTools.CreateFolder mailbox
Dim files
Dim i As Long
' Get all *.eml files in specified folder and parse it one by one.
files = oTools.GetFiles(mailbox & "\*.eml")
For i = LBound(files) To UBound(files)
ParseEmail files(i)
Next
Exit Sub
ErrorHandle:
MsgBox Err.Description
End Sub
Next Section
At next section I will introduce how to convert email to HTML page and display it in Web browser.
Appendix
Comments
If you have any comments or questions about above example codes, please click here to add your comments.