[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Sending HTML formatted email via Outlook from Access

Posted on 2016-09-05
4
Medium Priority
?
95 Views
Last Modified: 2016-09-06
I using the code below to send emails to Outlook from Access. In the sbody section after "Hi" I would like to insert a name from a field in a table. Thanks


Dim sSubj As String, sBody As String, sTo As String, strCC As String
Dim rst As DAO.Recordset
Dim rs As DAO.Recordset

'Get Active Users
Set rst = CurrentDb.OpenRecordset("SELECT tblUserMaster.OpDiv, tblUserMaster.Fname, tblUserMaster.Lname, tblUserMaster.Level, tblUserMaster.Approver FROM tblUserMaster WHERE (((tblUserMaster.Active) = Yes) And ((tblUserMaster.OpDiv) = 'CDC')) GROUP BY tblUserMaster.OpDiv, tblUserMaster.Fname, tblUserMaster.Lname, tblUserMaster.Level, tblUserMaster.Approver")


'Get Email Address
Set rs = CurrentDb.OpenRecordset("tblCDCEmail")

Do Until rs.EOF
     sMail = sMail & ";" & rs("email")
    rs.MoveNext
Loop

sMail = Mid(sMail, 2)


Set objOutlook = CreateObject("Outlook.Application")
Set objEmailMessage = objOutlook.CreateItem(0)

With objEmailMessage
         .To = sMail
         If strCC & "" <> "" Then
                    .CC = strCC
         End If
         .Subject = sSubj
      
      
 Do Until rst.EOF
   sBody = sBody & "</tr><td>" & rst("Fname") & "</td><td>" & rst("Lname") & "</td><td>" & rst("Level") & "</td></tr>"
   rst.MoveNext
 Loop
     

'Set body format to HTML
'.BodyFormat = olFormatHTML
.CC = "FESMCustomerService@hhs.gov"
.Subject = "CFRS User Certification"
      
sBody = "Hi,<br>In anticipation of CFRS Quarterly User Certification, would you please review the CDC users listed below and confirm that they are current and correct? Should access changes be necessary, please provide the CFRS User Access Request form. " & _
"<br><br><table><br>" & sBody & "</table><br><b><i><br>Thank You,<br><br>Alfonso N. Giansanti II<br>Contractor to: ASFR Office of Finance Systems Policy & Oversight<br>U.S. Department of Health and Human Services<br><br>Deloitte Consulting LLP <br>Mobile: 860-908-8381 | FAX: 877-570-8542 | alfonso.giansanti@hhs.gov<br><br><br><br>FESM Customer Service </i></div></body></html>"

 .HTMLBody = sBody
      
      .Display
      '      .send
      
     'Open Outlook
'SendKeys ("%{TAB}")
DoCmd.RunCommand acCmdAppMinimize

End With

Open in new window

0
Comment
Question by:shieldsco
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 31

Expert Comment

by:Helen Feddema
ID: 41785212
Save the name to a string variable, and include it in the line of HTML code; here is an example of creating an HTML email message (see the Create Line of Body Text section):

Public Sub CreateEmails()
'Created by Helen Feddema 31-Jan-2010
'Last modified by Helen Feddema 7-Feb-2010

On Error GoTo ErrorHandler

   Dim appOutlook As New Outlook.Application
   Dim dtePickup As Date
   Dim dteSold As Date
   Dim msg As Outlook.MailItem
   Dim rstAll As DAO.Recordset
   Dim rstSingle As DAO.Recordset
   Dim strBody As String
   Dim strCompany As String
   Dim strEMail As String
   Dim strFCFNumber As String
   Dim strGrade1 As String
   Dim strGrade2 As String
   Dim strHeader As String
   Dim strHTMLBody As String
   Dim strLine1 As String
   Dim strLine2 As String
   Dim strNotes As String
   Dim strQueryAll As String
   Dim strQuerySingle As String
   Dim strSignature As String
   Dim strSubject As String
   
   Set dbs = CurrentDb
   strQueryAll = "qrySendEmails"
   Set rstAll = dbs.OpenRecordset(strQueryAll)
   strQuerySingle = "qryTempEmail"
   strSignature = "</table><br><br><font face='Book Antiqua', size=5>" _
      & "<align='left'><u>John Doe</u></font><br>" _
      & "<font face='Arial', size=3><br>" _
      & "VP of Sales and Marketing<br>" _
      & "JD Inc.<br>" _
      & "Ph: 555-112-9601<br>" _
      & "Fx: 555-112-9422<br>"
   Debug.Print "Signature: " & strSignature
   
   Do While Not rstAll.EOF
      'Create filtered recordset for this customer
      lngSupplierID = Nz(rstAll![CustomerID])
      
      If lngSupplierID <> 0 Then
         strSQL = "SELECT * FROM " & strQueryAll & " WHERE " _
            & "[CustomerID] = " & lngSupplierID & ";"
      End If
   
      Debug.Print "SQL for " & strQuerySingle & ": " & strSQL
      lngCount = CreateAndTestQuery(strQuerySingle, strSQL)
      Debug.Print "No. of items found: " & lngCount
      If lngCount = 0 Then
         strPrompt = "No records found; canceling"
         strTitle = "Canceling"
         MsgBox strPrompt, vbOKOnly + vbCritical, strTitle
         GoTo ErrorHandlerExit
      Else
         'Create starter HTML text for this customer
         strHTMLBody = ""
         strHeader = "<p><img border='0' src='Image.jpg' " _
	    	& "width='559' height='120'></p> & "<font face='Arial', size=3>" _
            & "Please schedule the following: <br><br>" _
            & "<table width='791' border='1'>" _
            & "   <tr>" _
            & "      <td width='283'height='26' nowrap valign='bottom'" _
            & "align='left'><font face='Arial', size=3><strong>Grade</strong></font></td>" _
            & "      <td width='127' height='26'nowrap valign='bottom'" _
            & "align='left'><font face='Arial', size=3><strong>FCF Pickup #</strong></font>" _
            & "      <td width='144'height='26' nowrap valign='bottom'" _
            & "align='left'><font face='Arial', size=3><strong>Pickup Date</strong></font></td>" _
            & "      <td width='237'height='26' nowrap valign='bottom'" _
            & "align='left'><font face='Arial', size=3><strong>Notes</strong></font></td>" _
            & "   </tr>"

         Set rstSingle = dbs.OpenRecordset(strQuerySingle)
         strEMail = Nz(rstSingle![EmailAddress])
         strCompany = Nz(rstSingle![strCompany])
         strSubject = "Loads for " & strCompany
         
         'Create email for this customer
         Set msg = appOutlook.CreateItem(olMailItem)
         msg.To = strEMail
         msg.Subject = strSubject
         msg.BodyFormat = olFormatHTML
         
         'Process loads per customer
         Debug.Print "Processing load(s) for " & strCompany
         strBody = ""
         
         Do While Not rstSingle.EOF
            strLine1 = ""
            strLine2 = ""
            strGrade1 = ""
            strGrade2 = ""
            strSlipNo = Nz(rstSingle![SlipNo])
            dteSold = Nz(rstSingle![DateSold])
            dtePickup = Nz(rstSingle![ScheduledPickup])
            strFCFNumber = Nz(rstSingle![FCFNumber])
            strGrade1 = Nz(rstSingle![Grade1])
            Debug.Print "Grade 1: " & strGrade1
            strGrade2 = Nz(rstSingle![Grade2])
            Debug.Print "Grade 2: " & strGrade2
            strNotes = Nz(rstSingle![Notes])
            
            'Create line of body text
            strLine1 = "<font face='Arial', size=3" _
               & "   <tr>" _
               & "      <td width='283'valign='bottom' align='left'>" & strGrade1 & "</td>" _
               & "      <td width='127' valign='bottom' align='left'>" & strFCFNumber _
               & "      <td width='144'valign='bottom' align='left'>" _
               & Format(dtePickup, "m/d/yyyy") & "</td>" _
               & "      <td width='237'valign='bottom' align='left'>" & strNotes & "</td>" _
               & "   </tr></font>"
            Debug.Print "Line 1: " & strLine1
            
            If strGrade2 <> "" Then
               strLine2 = "<font face='Arial', size=3>" _
                  & "   <tr>" _
                  & "      <td width='283'valign='bottom' align='left'>" & strGrade2 & "</td>" _
                  & "      <td width='127' valign='bottom' align='left'>" & strFJDNumber _
                  & "      <td width='144'valign='bottom' align='left'>" _
                  & Format(dtePickup, "m/d/yyyy") & "</td>" _
                  & "      <td width='237'valign='bottom' align='left'>" _
                  & strNotes & "</font></td>" _
                  & "   </tr>"
            End If
            Debug.Print "Line 2: " & strLine2
         
            strHTMLBody = strHTMLBody & strLine1 & strLine2
            rstSingle.MoveNext
         Loop
         
         strHTMLBody = strHeader & strHTMLBody & strSignature
         Debug.Print "Message HTML body: " & strHTMLBody
         
         msg.HTMLBody = strHTMLBody
         msg.Display
         
      End If
      rstAll.MoveNext
   Loop
   
ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   MsgBox "Error No: " & Err.Number _
      & " in CreateEmails procedure; " _
      & "Description: " & Err.Description
   Resume ErrorHandlerExit

End Sub

Open in new window

0
 

Author Comment

by:shieldsco
ID: 41785249
How do I incorporate in my code
0
 
LVL 31

Accepted Solution

by:
Helen Feddema earned 2000 total points
ID: 41785280
I would set a strName variable to rst![FirstName] & " " & rst![LastName], and then use it in the line of code as follows:

sBody = "Hi, " & strName & "<br>.  In anticipation of CFRS Quarterly User Certification, would you please review the CDC users listed below and confirm that they are current and correct? Should access changes be necessary, please provide the CFRS User Access Request form. " & _
"<br><br><table><br>" & sBody & "</table><br><b><i><br>Thank You,<br><br>Alfonso N. Giansanti II<br>Contractor to: ASFR Office of Finance Systems Policy & Oversight<br>U.S. Department of Health and Human Services<br><br>Deloitte Consulting LLP <br>Mobile: 860-908-8381 | FAX: 877-570-8542 | alfonso.giansanti@hhs.gov<br><br><br><br>FESM Customer Service </i></div></body></html>"

Open in new window


I think you might need to clean up redundant <br> codes -- Outlook HTML is tricky, and needs a lot of debugging.
0
 

Author Closing Comment

by:shieldsco
ID: 41786179
Thanks so much
0

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Traditionally, the method to display pictures in Access forms and reports is to first download them from URLs to a folder, record the path in a table and then let the form or report pull the pictures from that folder. But why not let Windows retr…
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …

656 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question