Adding HTML text to email with HTML text (1 Viewer)

david_johnson · Nov 7, 2017

So I don't know if this is my limited experience with HTML or what but it seems what I need to do is simple, though it won't work. I need to create an email with some variables here and there, and then underneath I need an HTML table that pulls from an Access table. The part I thought difficult, the table, is already complete and works very well. I cannot figure out how to add text before the table, the body of the email. I would be most grateful is someone could show me how to add some lines of HTML text and have them included.

Private Sub Command1_Click()
Dim olApp As Object
Dim olItem As Variant
Dim db As DAO.Database
Dim rec As DAO.Recordset
Dim strQry As String
Dim aHead(1 To 4) As String
Dim aRow(1 To 4) As String
Dim aBody() As String
Dim lCnt As Long
Dim bBody As String

'Create the header row
aHead(1) = "Contact Role"
aHead(2) = "Contact Name"
aHead(3) = "Contact Phone Number"
aHead(4) = "Contact Email"

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

'Create each body row
strQry = "SELECT * From test_table"
Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset(strQry)

If Not (rec.BOF And rec.EOF) Then
Do While Not rec.EOF
lCnt = lCnt + 1
ReDim Preserve aBody(1 To lCnt)
aRow(1) = rec("contact_type")
aRow(2) = rec("contact_name")
aRow(3) = rec("contact_phone")
aRow(4) = rec("contact_email")
aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
rec.MoveNext
Loop
End If

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)

olItem.display
olItem.To = "example@example.com"
olItem.Subject = "Test E-mail"
olItem.htmlbody = Join(aBody, vbNewLine)

olItem.display
End Sub

Mark_ · Nov 7, 2017

So instead of

Code:

lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body><table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

you are looking for

Code:

Dim asPreTable as String

asPreTable = "Your HTML code here"
lCnt = 1
ReDim aBody(1 To lCnt)
aBody(lCnt) = "<HTML><body>" & asPreTable & "<table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"

Is that about right?

Also, please use the "#" to wrap code tags around samples of code. Makes it much easier to read.

arnelgp · Nov 8, 2017

you may also try this:

Code:

Dim strHTML As String
    strHTML = _
            "<table border=""2"" width=""100%"">" & _
                "<style>" & _
                    "th { color:#FFFFFF; background-color:#0099FF }" & _
                    "td { vertical-align:top; align:left; padding-left:5px; background-color:#CCCCCC }" & _
                    "</style>" & _
                "<th>Contact Role</th>" & _
                "<th>Contact Name</th>" & _
                "<th>Contact Phone Number</th>" & _
                "<th>Contact Email</th>"
    
    Set rec = CurrentDb.OpenRecordset(strQry, dbOpenSnapshot)
    
    With rec
        If Not (.BOF And .EOF) Then .MoveFirst
        While Not .EOF
            strHTML = strHTML & "<tr>"
            strHTML = strHTML & "<td>" & rec("contact_type") & "" & "</td>"
            strHTML = strHTML & "<td>" & rec("contact_name") & "" & "</td>"
            strHTML = strHTML & "<td>" & rec("contact_phone") & "" & "</td>"
            strHTML = strHTML & "<td>" & rec("contact_email") & "" & "</td>"
            strHTML = strHTML & "</tr>"
            .MoveNext
        Wend
        .Close
    End With
    Set rec = Nothing
    strHTML = strHTML & "</table>"
    
    Set olApp = CreateObject("Outlook.Application")
    Set olItem = olApp.CreateItem(0)
    With olItem
        .To = "example@example.com"
        .Subject = "Test E-mail"
        .HTMLBody = strHTML
        .Display
    End With

david_johnson · Nov 8, 2017

Yes, I believe that is what I'm looking for. I'll try it out. Thanks!

david_johnson · Nov 8, 2017

So that worked perfectly. My needs have changed somewhat and I need the table in between text. Building on your method Mark, I declared "asPostTable" but I can't figure out how to insert it. The code below inserts the post-table text into the rightmost column heading in the table. What am I missing? Thanks!!

Code:

lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body>" & asPreTable & "<table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>" & asPostTable

arnelgp · Nov 8, 2017

To make it more appealing:

Code:

"<table border=""2"" width=""100%"">" & _
                "<style>" & _
                    "th { color:#FFFFFF; padding: 10px 10px 10px 10px: background-color:#0099FF }" & _
                    "td { vertical-align:top; align:left; padding:5px 5px 5px 5px; background-color:#CCCCCC }" & _
                    "</style>" & _
                "<th>Contact Role</th>" & _
                "<th>Contact Name</th>" & _
                "<th>Contact Phone Number</th>" & _
                "<th>Contact Email</th>"

Mark_ · Nov 8, 2017

asPostTable would need to be after your final </table>. That ends the structure in HTML.

Code:

aBody(lCnt) = aBody(lCnt) & "</table></body></html>"

becomes

Code:

aBody(lCnt) = aBody(lCnt) & "</table>[B]" & asPostTable & "[/B]</body></html>"

david_johnson · Nov 9, 2017

That code worked perfectly, thanks! I'm having what, I hope, is my last issue before being done. I have two tables. One contains a list of applicants, the other the list of contacts for that applicant that will feed the email's table. The join is on the Applicant ID, so in the contacts table 6 rows will have the same applicant ID (always 6). What I can't figure out how to do is to filter the list so that it only pulls the contacts for the matching applicant ID. I've managed to nest the iterations without help. The problem is that it pulls the entire contact set for each applicant iteration. A related problem, I can't seem to pull the applicant email for each iteration, I always only get the first applicant. I suppose my problem is that I can't seem to figure out the code to pull field values for the iteration I'm currently in at any given time.

I appreciate all your help so far, it's been very critical to this project. I've included teh code below for reference. Thanks again!

Code:

Private Sub Command1_Click()
    Dim olApp As Object
    Dim olItem As Variant
    Dim db As DAO.Database
    Dim rec As DAO.Recordset
    Dim strQry As String
    Dim aHead(1 To 5) As String
    Dim aRow(1 To 5) As String
    Dim aBody() As String
    Dim lCnt As Long
    Dim asPreTable As String
    Dim asPostTable As String
    Dim appsrec As DAO.Recordset
    Dim str_app_SQL As String
    Dim ApplicantID As Integer
    
    
    str_app_SQL = "SELECT * FROM applicant_list"
    Set appsrec = CurrentDb.OpenRecordset(str_app_SQL)
    
    If Not appsrec.BOF And Not appsrec.EOF Then
        appsrec.MoveFirst
        Do While Not appsrec.EOF

        
        
    'Create the header row
    aHead(1) = "Agency"
    aHead(2) = "Role"
    aHead(3) = "Name"
    aHead(4) = "Phone"
    aHead(5) = "Email"
    

     
    asPreTable = "Greetings, <br>" _
               & "<br>Addressing the unique recovery needs of disaster-impacted communities requires a collaborative effort involving state and federal agencies in conjunction with local jurisdictions and leaders. I am contacting you today to provide you with information on the various individuals and organizations that will be providing support throughout the FEMA Public Assistance (PA) recovery process.  The table below provides contact information for individuals serving in essential roles related to your community's recovery under the PA program:<br><br>" _
                         
               
    asPostTable = "<br><br><b><i>FEMA Roles and Responsibilities</i></b><br>" _
                & "FEMA is responsible for making eligibility determinations for all your reported losses and for approving funding through Project Worksheets (PWs) for eligible damages.  Over the coming weeks and months, your designated FEMA Program Delivery Manager (PDMG) will work with you extensively to assess damages and collect information/documentation required for the approval of PWs.<br><br>" _
                & "<b><i>TDEM Roles and Responsibilities</i></b><br>" _
                & "TDEM is responsible for grant administration and compliance support; this includes assistance with processing your reimbursement requests, time extensions, necessary scope of work modifications, final financial reconciliation, as well as grant closeout. As these needs surface, TDEM will provide technical assistance and policy guidance as it pertains to your PWs. TDEM's objective is to ensure your recovery efforts are completed in compliance with local and federal regulations.<br><br>" _
                & "The firm I work for, CohnReznick, is contracted by the Texas Division of Emergency Management (TDEM) to assist with implementation and delivery of the FEMA PA Program.  As your TDEM Grant Coordinator, I am responsible for assisting you in effectively navigating the recovery process and for providing any needed technical or financial support to address your day-to-day recovery needs.  I will be working with you extensively throughout the recovery process; however, I am a part of a larger team that is comprised of other specialized personnel who may also periodically contact you regarding certain aspects of your projects or to request documentation needed to support reimbursements.       Our team works under the supervision and direction of the TDEM Recovery Liaison and Section Administrator overseeing recovery efforts in your region and these State resources are available and equipped to provide additional support to you as needed.<br><br>" _
                & "In the coming days we will be providing additional guidance and reaching out to set up a meeting to discuss the recovery process in more detail and to answer any questions you might have. Please feel free to reach out to me at any time.<br><br>" _
                & "Respectfully,<br>" _
                & "Grant Coordinator Name"
                
                
    lCnt = 1
    ReDim aBody(1 To lCnt)
    aBody(lCnt) = "<HTML><body>" & asPreTable & "<table border='2'><tr><th>" & Join(aHead, "</th><th>") & "</th></tr>"
    

    'Create each body row
    strQry = "SELECT * From contacts_table_primary"
    Set db = CurrentDb
    Set rec = CurrentDb.OpenRecordset(strQry)

    If Not (rec.BOF And rec.EOF) Then
        Do While Not rec.EOF
            lCnt = lCnt + 1
            ReDim Preserve aBody(1 To lCnt)
            aRow(1) = rec("contact_agency")
            aRow(2) = rec("contact_role")
            aRow(3) = rec("contact_name")
            aRow(4) = rec("contact_phone")
            aRow(5) = rec("contact_email")
            aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
            rec.MoveNext
        Loop
    End If

    aBody(lCnt) = aBody(lCnt) & "</table>" & asPostTable & "</body></html>"

    
    'create the email
    Set olApp = CreateObject("Outlook.application")
    Set olItem = olApp.CreateItem(0)

    olItem.display
    olItem.To = "example@example.com"
    olItem.Subject = "Test E-mail"
    olItem.htmlbody = Join(aBody, vbNewLine)
        
    olItem.display
    
    appsrec.MoveNext
    Loop
    
    End If
    appsrec.Close
    Set appsrec = Nothing
    
    
End Sub

Mark_ · Nov 14, 2017

So your question really becomes "How do I nest a loop within a loop?"

For myself, I would have one loop that calls a function to provide what the next loop needs. Something similar to

Code:

asEmailTo = BuildEmailList( aiAppId )

Then when you code the BuildEmailList function it would be something like;

Code:

Private Function BuildEmailList ( plID as Long )

Dim DAOrs As DAO.Recordset
Dim asSQL As String
Dim asEMails as String

asSQL = 'Select * From ContactList'
asSQL = asSQL & " WHERE ContactList.ApplicantID = " & plID

Set DAOrs = CurrentDB.OpenRecordSet ( asSQL )	

IF NOT (DAOrs.EOF and DAOrs.BOF) then
   DAOrs.MoveFirst
   Do Until DAOrs.EOF = TRUE
      asEMails = asEmails & ContactList.Email & "; " 
      DAOrs.MoveNext
   Loop	
ELSE
   asEMails = ""
End If

DAOrs.Close
SET DAOrs = Nothing

BuildEmailList = asEmails

End Function

This way you have separate pieces you can test that each do one specific thing. Once each piece works you then build up the rest of the pieces around them. It also avoids having to wade through pages of code to figure out what you are doing and what could be going wrong.

Adding HTML text to email with HTML text (1 Viewer)

david_johnson

Registered User.

Mark_

Longboard on the internet

arnelgp

..forever waiting... waiting for jellybean!

david_johnson

Registered User.

david_johnson

Registered User.

arnelgp

..forever waiting... waiting for jellybean!

Mark_

Longboard on the internet

david_johnson

Registered User.

Mark_

Longboard on the internet

Similar threads

Users who are viewing this thread