' The following example codes demonstrate converting email to HTML page
' To get full sample projects, please download and install EAGetMail on your machine.
' To run it correctly, please change email server, user, password, folder, file name value to yours

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 

' We generate a html + attachment folder for every email, once the html is create,
' Next time we don't need to parse the email again.
Private Sub GenerateHtmlForEmail(ByVal htmlName As String, _ 
    ByVal emlFile As String, ByVal tempFolder As String) 

    On Error GoTo ErrorGenHtml 

    Dim oMail As New EAGetMailObjLib.Mail 
    oMail.LicenseCode = "TryIt" 

    oMail.LoadFile emlFile, False 
    If Err.Number <> 0 Then 
        MsgBox Err.Description 
        Exit Sub 
    End If 

    On Error Resume Next 
    If oMail.IsEncrypted Then 
        Set oMail = oMail.Decrypt(Nothing) 
        If Err.Number <> 0 Then 
            MsgBox Err.Description 
        End If 
    End If 

    If oMail.IsSigned Then 
        oMail.VerifySignature 
        If Err.Number <> 0 Then 
            MsgBox Err.Description 
        End If 
    End If 

    On Error GoTo ErrorGenHtml 

    Dim html As String 
    html = oMail.HtmlBody 
    Dim hdr As String 
    hdr = hdr & "<font face=""Courier New,Arial"" size=2>" 
    hdr = hdr & "<b>From:</b> " + FormatHtmlTag(oMail.From.name & "<" & _ 
     oMail.From.Address & ">") + "<br>" 

    Dim addrs 
    addrs = oMail.To 
    Dim i, Count 

    i = LBound(addrs) 
    Count = UBound(addrs) 
    If (Count >= i) Then 
        hdr = hdr & "<b>To:</b> " 
        For i = LBound(addrs) To Count 
            hdr = hdr & FormatHtmlTag(addrs(i).name & "<" & addrs(i).Address & ">") 
            If (i < Count) Then 
                hdr = hdr & ";" 
            End If 
        Next 
        hdr = hdr & "<br>" 
    End If 

    addrs = oMail.Cc 
    i = LBound(addrs) 
    Count = UBound(addrs) 
    If (Count >= i) Then 
        hdr = hdr & "<b>Cc:</b> " 
        For i = LBound(addrs) To Count 
            hdr = hdr & FormatHtmlTag(addrs(i).name & "<" & addrs(i).Address & ">") 
            If (i < Count) Then 
                hdr = hdr & ";" 
            End If 
        Next 
        hdr = hdr & "<br>" 
    End If 

    hdr = hdr & "<b>Subject:</b>" & FormatHtmlTag(oMail.Subject) & "<br>" & vbCrLf 
    Dim atts 
    atts = oMail.Attachments 
    i = LBound(atts) 
    Count = UBound(atts) 
    If (Count >= i) Then 
        If Not oTools.ExistFile(tempFolder) Then 
            oTools.CreateFolder (tempFolder) 
        End If 

        hdr = hdr & "<b>Attachments:</b>" 
        For i = LBound(atts) To Count 
            Dim att As Attachment 
            Set att = atts(i) 
            If LCase(att.name) = "winmail.dat" Then 
                Dim tatts 
                tatts = oMail.ParseTNEF(att.Content, True) 
                Dim x As Integer 
                For x = LBound(tatts) To UBound(tatts) 
                    Dim tatt As Attachment 
                    Set tatt = tatts(x) 
                    Dim tattname As String 
                    tattname = tempFolder & \" & tatt.name 
                    tatt.SaveAs tattname, True 
                    hdr = hdr & "<a href=""" & tattname & """ target=""_blank"">" _ 
                        & tatt.name & "</a> " 
                Next 
            Else 
                Dim attname 
                attname = tempFolder & \" & att.name 
                att.SaveAs attname, True 
                hdr = hdr & "<a href=""" & attname & """ target=""_blank"">" & att.name & "</a> " 
                If Len(att.ContentID) > 0 Then 
                    'show embedded image.
                    html = Replace(html, "cid:" + att.ContentID, attname) 
                ElseIf InStr(1, att.ContentType, "image/", vbTextCompare) = 1 Then 
                    'show attached image.
                    html = html & "<hr><img src=""" & attname & """>" 
                End If 
            End If 
        Next 
    End If 

    hdr = "<meta HTTP-EQUIV=""Content-Type"" Content=""text-html; charset=utf-8"">" & hdr 
    html = hdr & "<hr>" & html 
    oTools.WriteTextFile htmlName, html, 65001 
    oMail.Clear 
    Exit Sub 

ErrorGenHtml: 
    MsgBox "Failed to generate html file for the email; " & Err.Description 

End Sub 

Private Function FormatHtmlTag(ByVal src As String) As String 
    src = Replace(src, ">", "&gt;") 
    src = Replace(src, "<", "&lt;") 
    FormatHtmlTag = src 
End Function 

Private Sub ConvertMailToHtml(ByVal fileName As String) 
    Dim pos 
    pos = InStrRev(fileName, ".") 
    Dim mainName 
    Dim htmlName 
    mainName = Mid(fileName, 1, pos - 1) 
    htmlName = mainName & ".htm" 

    Dim tempFolder As String 
    tempFolder = mainName 
    If Not (oTools.ExistFile(htmlName)) Then 
        ' We haven't generate the html for this email, generate it now.
        GenerateHtmlForEmail htmlName, fileName, tempFolder 
    End If 

End Sub 

Private Sub Command1_Click() 

    ConvertMailToHtml "c:\my folder\test.eml" 

    Exit Sub 
ErrorHandle: 
    MsgBox Err.Description 
End Sub