Excel

Merge Custom HTML Email

Ease of Use

Intermediate

Version tested with

2003, 2000 

Submitted by:

slink9

Description:

This code creates a customized HTML email from Excel, allows you to view and control it within Excel, and then tags the address as sent 

Discussion:

There are two macros listed here. Type both in along with creating the Excel spreadsheet as indicated below and in the attached file. Put as many names and email addresses as desired and then run the macro. Outlook's security prompt may require that you acknowledge every email that is sent. Notice that the set SafeItem = ? and the SafeItem.Item = ? lines are commented out. This is required if your system has an add-in called Redemption. If Redemption is installed, then the lines following those that have themail.Recipients (or similar text) would need to be changed to SafeItem.Recipients. This occurs seven times in the macro above. The Send_Mail is the routine that actually handles sending the mail. It looks at rows 2 and below (1 is the header) and processes the mail according to the cell contents. Send_Mail resolves the e-mail address based on your Contacts list. If it finds a contact by the first and last names you entered, it uses that e-mail address and places the word SENT in column F. If it does not find the names, Send_Mail prompts you to enter a valid e-mail address and click Send. It then places Manually Checked in column F. The Set_Body function creates the HTML formatted e-mail. This function contains HTML ?commands? that control the formatting (fonts, colors) of the e-mail to be sent. This could be changed to Set_Body = ?Test E-mail? if you prefer to create a much simpler e-mail. The Excel spreadsheet should have headers in the first row and data following that. The data columns are defined by their names (First Name, Last Name, E-mail address, ISP ID). The next column determines whether or not to send the e-mail to this person (put a YES if this person is to receive the e-mail). The last column displays the results of the send. The spreadsheet layout is below. A B C D E F First Name Last Name Email Address ISP ID Send? Sent? Steve Link slink@linkemup.us slink Yes Yes Barney Link blink@linkemup.us blink Yes If there is nothing in the SENT? column the macro will send the macro when it has YES in the Send? column Test file is for Excel 2003 only 

Code:

instructions for use 

			
Option Explicit 
Dim olApp As Outlook.Application 
Dim themail As Outlook.MailItem 
 
Function set_body(displayName As String, ISPAccount As String)  As String 
     
    set_body = "<html>" 
    set_body = set_body & "<head>" 
    set_body = set_body & "<meta http-equiv='Content-Type' content='text/html; charset=windows-1252'>" 
    set_body = set_body & "<meta name='GENERATOR' content='Microsoft FrontPage 4.0'>" 
    set_body = set_body & "<meta name='ProgId' content='FrontPage.Editor.Document'>" 
    set_body = set_body & "<title>New Page 1</title>" 
    set_body = set_body & "</head>" 
    set_body = set_body & "<body>" 
    set_body = set_body & "<div><font face='Verdana'>To the attention of: <b>" & displayName & "</b></font><br>" 
    set_body = set_body & "  <font face='Verdana'> Your" 
    set_body = set_body & "  ISP account: <font color='#FF0000'><b>(" & ISPAccount & ")</b></font>" 
    set_body = set_body & "  </font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana'>According to  the" 
    set_body = set_body & "  ISP billing system you?have not used your ISP account" 
    set_body = set_body & "  since January 1st, 2003.</font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana'><strong>We would like you" 
    set_body = set_body & "  to confirm by return e-mail that you have a regular use of it</strong>, <strong>otherwise" 
    set_body = set_body & "  <font color=#ff0000>your ISP account  will be deactivated on May 31st, _ 2003</font></strong>?as we " 
    set_body = set_body & "  cannot afford to keep?wasting money on unused subscriptions.</font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana' size='2'>Note: <u>Alternative" 
    set_body = set_body & "  solutions to accessing mail and Intranet</u><font color='#0000ff'></font></font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana' size='2' color='#0000ff'><u>Using" 
    set_body = set_body & "  CGG laptop: </u>?</font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <ul>" 
    set_body = set_body & "    <li><font face='Verdana' size='2'>Most" 
    set_body = set_body & "      of the processing centers and agencies are now connected to our" 
    set_body = set_body & "      network thus allowing you to access your mailbox through either Outlook or" 
    set_body = set_body & "      Webmail (requires a specific authorization).</font></li>" 
    set_body = set_body & "  </ul>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <ul>" 
    set_body = set_body & "    <li><font face='Verdana' size='2'>A fairly" 
    set_body = set_body & "      large number of you already have a DSL or a cable Internet access at home" 
    set_body = set_body & "      on which SecureRemote (VPN) can be used to access our internal network" 
    set_body = set_body & "      (requires a SecurID card)</font></li>" 
    set_body = set_body & "  </ul>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <ul>" 
    set_body = set_body & "    <li><font face='Verdana' size='2'>Some" 
    set_body = set_body & "      countries such as France have free Internet access (freesurf, free, ...)," 
    set_body = set_body & "      on which SecureRemote (VPN) can be used to access our internal network" 
    set_body = set_body & "      (requires a SecurID card)</font></li>" 
    set_body = set_body & "  </ul>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <ul>" 
    set_body = set_body & "    <li><font face='Verdana' size='2'>Some" 
    set_body = set_body & "      countries such as MiddleEast have only a local ISP offering (i.e." 
    set_body = set_body & "      ISP is not working) on which SecureRemote (VPN) can be used to" 
    set_body = set_body & "      access our internal network (requires a SecurID card)</font></li>" 
    set_body = set_body & "  </ul>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <ul>" 
    set_body = set_body & "    <li><font face='Verdana' size='2'>Some" 
    set_body = set_body & "      countries such as South America are better served by ATT than by" 
    set_body = set_body & "      ISP (some of you have already an ATT account)</font></li>" 
    set_body = set_body & "  </ul>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana' color='#0000ff' size='2'><u>Without" 
    set_body = set_body & "  CGG PC:</u></font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana' size='2'>And finally, we" 
    set_body = set_body & "  are in the process of opening the access to a Webmail and intranet access" 
    set_body = set_body & "  from any Internet access (cybercaf's, hotels, hot-spots, ...), you will only" 
    set_body = set_body & "  need to carry your SecuriD card and remember your e-mail aliasname and" 
    set_body = set_body & "  domain.</font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana'>Regards,</font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  ?" 
    set_body = set_body & "</div>" 
    set_body = set_body & "<div>" 
    set_body = set_body & "  <font face='Verdana' size='2'>" 
    set_body = set_body & "  <div>" 
    set_body = set_body & "    <font face='Verdana' color=_ '#000080' size='2'><strong>IT Security</strong></font>" 
    set_body = set_body & "  </div>" 
    set_body = set_body & "  </font>" 
    set_body = set_body & "</div>" 
    set_body = set_body & "</body>" 
    set_body = set_body & "</html>" 
     
End Function 
 '-----------------------------------------
 
Sub sendMail_click() 
    Dim SafeItem As Object 
     
    Dim i As Integer 
    Dim nr As Integer 
    Dim accISP As String 
    Dim dispN As String 
    Dim olExist As Boolean 
    Dim emailN As String 
     
    Dim olApp As Outlook.Application 
     
    olExist = True 
    On Error Resume Next 
    Set olApp = GetObject(, "Outlook.Application") 
     
    If Err.Number <> 0 Then 
        olExist = False 
        Err.Clear 
        On Error Resume Next 
        If Not IsEmpty(olApp) Then 
            Set olApp = CreateObject("Outlook.Application") 
        End If 
         
        If Err.Number <> 0 Then 
            Err.Clear 
            MsgBox "Cant start Outlook", vbCritical, "Error" 
            Exit Sub 
        End If 
    End If 
     'olApp.Visible = True
    nr = ActiveSheet.UsedRange.Rows.Count 
    For i = 2 To nr 
        If UCase(Cells(i, 5).Value) = "YES" And Cells(i, 6).Value = "" Then 
            dispN = Cells(i, 2).Value & ", " & Cells(i, 1).Value 
            accISP = Cells(i, 4).Value 
            If Cells(i, 3).Value = "" Then 
                emailN = Cells(i, 2).Value & ", " & Cells(i, 1) 
            Else 
                emailN = Cells(i, 3).Value 
            End If 
            ?            Set SafeItem = _ CreateObject("Redemption.Safe-mailItem") 'Create an instance of _ Redemption.Safe-mailItem
            Set themail = olApp.CreateItem(olMailItem) 'Create a new message
            ?            SafeItem.Item = themail 'set Item property
            themail.Recipients.Add dispN 
            themail.Recipients.ResolveAll 
            themail.HTMLBody = set_body(dispN, accISP) 
            themail.Subject = "Your ISP account (" & accISP & ")" 
            If themail.Recipients.ResolveAll Then 
                themail.Send 
                Cells(i, 6).Value = "Sent" 
            Else 
                themail.Display True 
                Cells(i, 6).Value = "Manually checked" 
            End If 
             
            Set themail = Nothing 
            Set SafeItem = Nothing 
             
        End If 
    Next 
     
    If olExist = False Then 
        olApp.Application.Quit 
        Set olApp = Nothing 
    End If 
End Sub

How to use:

  1. Copy code.
  2. From Word, press Alt + F11.
  3. Select file on left, press Insert -> Module.
  4. Paste code on right.
  5. Set the correct path to Custom.dic where indicated below the asterisks.
  6. In ThisDocument module, Add DocumentOpen and DocumentClose macros to call SetSpacebar and ClearSpacebar respectively (as shown in example file).
  7. Save and close the document.
  8. On reopening, the macro should start automatically.
  9. More detailed instructions for use are given in the attached file
 

Test the code:

  1. Sample spreadsheet is shown above and the attached file
  2. Enter the name and email address as indicated.
  3. The ISP ID is for informational and merging purposes only.
  4. If Yes is in the Send? column the email will be generated and sent
  5. It will fill in the SENT? column with either Yes or Manual
 

Sample File:

outlook test.zip 12.2KB 

Approved by mdmackillop


This entry has been viewed 186 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express