VB.NET Emailing System Based on Templates

Introduction

I am working as a volunteer for an NGO that needed a refreshment of their various databases and one of them is their "Contact" database which manages all donations. This application uses an SQL server database and automatically creates the emails that are sent to the donors, first to thank them and second, to send them the tax receipt document at the appropriate time. Some donors are well known and will not receive a standard "thank you" email, but rather a customized text. Some tax receipts are required immediately, others are required at year end. They can also be in different languages depending on the donor's country. Tax receipts are PDF attachments.

Background

This NGO doesn't have an IT team and templates must be easy to maintain by someone with office knowledge but certainly no HTML skills. The budget is limited, so I try to use whatever is available free while making sure that it is stable and reliable.

Templates contain pictures, most of the time 2: one logo at the top of the email and one picture showing kids in various environments at the bottom of the text. However, the sender can choose other pictures if he knows the donor personally and want to remind him of some particular event. The email template contains tags that will be dynamically replaced by the database content when the email is made ready. Tags are in the form #firstname.

I did a lot of research while developing this function and I initially thought that it would be an easy task. I want to particularly point to the following 3 articles on CodeProject that were a tremendous help in making this work:

• Building a Simple Word Processor Around an Extended RichTextBox Control
• Converting RTF to HTML in VB.NET the Easy Way
• A Windows Forms based text editor with HTML output

I initially tried to use article 15559 which describes an excellent way to use the webbrowser control as an HTML editor. Then, I found it very difficult to use with templates, mainly for two reasons:

1. If you insert an image, it is embedded in the HTML code and will be rejected by most email servers. If you just insert an image and send the email right away, the application replaces the image by the appropriate CID, but this does not work with a template already containing the image in binary format.
2. I couldn't find a way to replace the #xxx tags by their values from the database, as any attempt to modify the innerhtml resulted in freezing the webbrowser control. Maybe someone with much more experience can explain to me the way to accomplish this. One way was to avoid using the navigate command to display the template, read it with a stream and put it into the innerhtml property, but then the images do not show as they are in the form src=file.

So the final solution uses the following steps:

1. Read the rtf template into an extended rich text box as described in article 15585, so that the user can modify the email content if desired. Replace the #xxx tags by the appropriate values from the database
2. When the user presses the send button, convert the RTF to HTML using the code given in article 51879. This works very fast and seems to be very stable.
3. Replace the src=file lines by the corresponding CID statements so that the images will be sent with the email body. This is accomplished by some code extracted from article 15559.
4. Attach the required PDF file if necessary.
5. Send the email asynchronously and update the database when the SendCompleted event is triggered, so that the same email is not sent twice by mistake.

Using the Code

I just display the subroutines that are involved in creating the email message from the rtf file. If anybody is interested in the full code, I can publish it later.

The first sub is used to load the rtf file into a Richtextbox while replacing the #xxx tags by the appropriate values from the database. In the final version, the rtf text will be stored in a text field in the database record, but the db is currently version 2005 and does not support text fields.

 Sub ReadTemplate()
        Rtf1.LoadFile("c:\ContactDatabase\Templates\TaxeEmail.rtf")
        Rtf1.Rtf = Rtf1.Rtf.Replace("#firstname", MyFirstName)
 End Sub  

 Private Sub SendButton_Click(sender As Object, e As EventArgs) Handles SendButton.Click
        Dim MyMessage As String
        Me.Cursor = Windows.Forms.Cursors.WaitCursor
        Try
            Dim Smtp_Server As New SmtpClient
            MyMessage = sRTF_To_HTML(RTF1.Rtf)		'convert to HTML
            Dim e_mail As New MailMessage()
            e_mail = ToMailMessage(MyMessage)		'Attach images with CID
            Smtp_Server.UseDefaultCredentials = False
            Smtp_Server.Credentials = _
            New Net.NetworkCredential("contact@MyMailServer", "psw")
            Smtp_Server.Port = 25    '587
            '       Smtp_Server.EnableSsl = True
            Smtp_Server.Host = "MyServer"
            e_mail.From = New MailAddress(TxtFrom.Text)
            e_mail.To.Add(EmailBox.Text)
            e_mail.Subject = SubjectBox.Text
            e_mail.IsBodyHtml = True
            e_mail.Attachments.Add(New Attachment(PdfFile))
            Dim userState As String = "ContactId " & CurrentId
            AddHandler Smtp_Server.SendCompleted, AddressOf SendCompletedCallback
            Smtp_Server.SendAsync(e_mail, userState)

        Catch error_t As Exception
            MsgBox(error_t.ToString)
        End Try
        MsgBox("Message Added to the queue", MsgBoxStyle.Information, MsgString)
        Me.Cursor = Windows.Forms.Cursors.Default
    End Sub 

Convert to HTML

Public Function sRTF_To_HTML(ByVal sRTF As String) As String

        Dim MyWord As New Microsoft.Office.Interop.Word.Application
        Dim oDoNotSaveChanges As Object = _
             Microsoft.Office.Interop.Word.WdSaveOptions.wdDoNotSaveChanges
        Dim sReturnString As String = ""
        Dim sConvertedString As String = ""
        Try
            MyWord = CreateObject("Word.application")
            MyWord.Visible = False
            MyWord.Documents.Add()

            Dim doRTF As New System.Windows.Forms.DataObject
            doRTF.SetData("Rich Text Format", sRTF)
            Clipboard.SetDataObject(doRTF)
            MyWord.Windows(1).Selection.Paste()
            MyWord.Windows(1).Selection.WholeStory()
            MyWord.Windows(1).Selection.Copy()
            sConvertedString = Clipboard.GetData(System.Windows.Forms.DataFormats.Html)
            'Remove some leading text that shows up in the email
            sConvertedString = sConvertedString.Substring(sConvertedString.IndexOf("<html"))
            'Also remove multiple  characters that somehow got inserted 
            sConvertedString = sConvertedString.Replace("Â", "")
            sReturnString = sConvertedString
            If Not MyWord Is Nothing Then
                MyWord.Quit(oDoNotSaveChanges)
                MyWord = Nothing
            End If
        Catch ex As Exception
            If Not MyWord Is Nothing Then
                MyWord.Quit(oDoNotSaveChanges)
                MyWord = Nothing
            End If
            MsgBox("Error converting Rich Text to HTML")
        End Try
        Return sReturnString
    End Function

Attach images via CID

Public Function ToMailMessage(Message As String) As MailMessage
        Dim html As String = Message
        If html IsNot Nothing Then
            Return LinkImages(html)
        End If
        Dim msg = New MailMessage()
        msg.IsBodyHtml = True
        Return msg
    End Function

Private Function LinkImages(html As String) As MailMessage
        Dim msg = New MailMessage()
        msg.IsBodyHtml = True
        Dim matches = Regex.Matches(html, "<img[^>]*?src\s*=\s*_
        ([""']?[^'"">]+?['""])[^>]*?>", _
        RegexOptions.IgnoreCase Or _
        RegexOptions.IgnorePatternWhitespace Or RegexOptions.Multiline)
        Dim img_list = New List(Of LinkedResource)()
        Dim cid = 1
        For Each match As Match In matches
            Dim src As String = match.Groups(1).Value
            src = src.Trim(""""c)
            Dim MyFile As String = Mid(src, 9, Len(src))
            If File.Exists(MyFile) Then
                Dim ext = Path.GetExtension(src)
                If ext.Length > 0 Then
                    ext = ext.Substring(1)
                    Dim res = New LinkedResource(MyFile)
                    res.ContentId = String.Format("img{0}.{1}", _
                    System.Math.Max(System.Threading.Interlocked.Increment(cid), cid - 1), ext)
                    res.TransferEncoding = System.Net.Mime.TransferEncoding.Base64
                    res.ContentType.MediaType = String.Format("image/{0}", ext)
                    res.ContentType.Name = res.ContentId
                    img_list.Add(res)
                    src = String.Format("'cid:{0}'", res.ContentId)
                    html = html.Replace(match.Groups(1).Value, src)
                End If
            End If
        Next
        Dim view = AlternateView.CreateAlternateViewFromString_
                  (html, Nothing, MediaTypeNames.Text.Html)
        For Each img As LinkedResource In img_list
            view.LinkedResources.Add(img)
        Next
        msg.AlternateViews.Add(view)
        Return msg
    End Function

Handle the sendCompleted Event

Sub SendCompletedCallback(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
        ' Get the unique identifier for this asynchronous operation. 
        Dim token As String = CStr(e.UserState)

        If e.Cancelled Then
            MsgBox("[{0}] Send canceled." & token)
        End If
        If e.Error IsNot Nothing Then
            MsgBox("[{0}] {1}" & " " & token & " " & e.Error.ToString())
        Else
            ' Insert here the code to update the database so that the email is marked sent
        End If
        mailSent = True
    End Sub

Points of Interest

There may be an easy way to maintain the templates directly in HTML and to use the webbrowser control as an editor, but I didn't find it. All my attempts to do so failed miserably and I decided to keep the templates in RTF format. If anybody knows a way to do this directly in HTML, please let me know.

Anyway, this set of subroutines works fine and there is the old saying "If it works, don't fix it."

History

• 26/7/2013 First test version completed