Need to loop through recordset to insert HTML table in Outlook email body

Question

I am attempting to loop through a recordset in Access VBA. The results are then to be output to an HTML formatted table in the email body of an Outlook item. I have been able to loop through all records in the recordset, as long as it is not formatted in HTML.

As soon as I insert the HTML string, the loop fails to return more than one record in the body of the email.

A Debug.Print counts the appropriate number of records in the recordset, but the HTML table only returns the header and one record.

The following code prints the entire recordset based on the query parameters. All rows are returned in text format with each data element pipe delimited:

Set dbs = CurrentDb()
Set qdf = dbs.QueryDefs("qryNewRequest")
qdf.Parameters(0) = Me![hdr_ID]
Set rst = qdf.OpenRecordset()

With rst
  Do While Not rst.EOF
  Mailbody = Mailbody & ![hdr_req_date] & " | " & ![usr_name] & _
  " | " & ![hdr_department] & " | " & ![dtl_req_eff_date] & _
  " | " & ![dtl_chg_cpt] & " | " & ![dtl_chg_rev] & _
  " | " & ![dtl_chg_price] & " | " & ![reason] & vbCrLf
  rst.MoveNext
  Loop
End With


Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)

olItem.display
olItem.To = "[email protected]"
olItem.Subject = "New Request"
olItem.body = Mailbody

However, when I try to format the results in an HTML table, only the header and the first row of the recordset is returned. See code below:

Set dbs = CurrentDb()
Set qdf = dbs.QueryDefs("qryNewRequest")
qdf.Parameters(0) = Me![hdr_ID]
Set rst = qdf.OpenRecordset()

strHTML = "<HTML><Body><table border='1' width='50%'><tr><th>Request Date</th><th>Submitted By</th>" & _
"<th>Department</th><th>Effective Date</th><th>Description</th></tr>"

With rst
  Do While Not rst.EOF
  Mailbody = strHTML & "<tr><td>" & rst("hdr_req_date") & "</td><td>" & _
        rst("usr_name") & "</td><td>" & rst("hdr_department") & "</td><td>" & _
        rst("dtl_req_eff_date") & "</td><td>" & rst("dtl_chg_desc") & "</td></tr>" & _
        vbCrLf

   rst.MoveNext
   Loop
End With

strHTML = strHTML & "</table></body></html>"

Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)

olItem.display
olItem.To = "[email protected]"
olItem.Subject = "New Request"
olItem.HTMLbody = Mailbody

Running the query directly from the Access form passes the parameter appropriately, and returns the correct number of records. The email item is created in both methods, so I believe my problem is in the HTML of the sub. As stated, a Debug.Print on the intCount of the recordset returns the appropriate number of records based on the query.

Am I missing something simple? I have done a lot of hunting and searching over the last few days, so I apologize if I missed another thread that has the answer. This is my first post, so bear with me as I learn the site rules and etiquette.

Thank you

Gabor Gabor · Accepted Answer · 2016-04-27T01:07:24

The problem is that you always append the current record to strHTML so it will contain only the last record added to strHTML.

Instead initialize MailBody with strHTML and append MailBody in each loop just like you did in the plain text version.

strHTML = "<HTML><Body><table border='1' width='50%'><tr><th>Request Date</th><th>Submitted By</th>" & _
"<th>Department</th><th>Effective Date</th><th>Description</th></tr>"

' Initialize Mailbody    
Mailbody = strHTML

With rst
  Do While Not rst.EOF

  ' Here you append the current record to the end of the Mailbody variable.
  Mailbody = Mailbody & "<tr><td>" & rst("hdr_req_date") & "</td><td>" & _
        rst("usr_name") & "</td><td>" & rst("hdr_department") & "</td><td>" & _
        rst("dtl_req_eff_date") & "</td><td>" & rst("dtl_chg_desc") & "</td></tr>" & _
        vbCrLf

   rst.MoveNext
   Loop
End With

Need to loop through recordset to insert HTML table in Outlook email body

1 Answers