I inherited a database with a VBA module that inserts a data table into an Outlook email. I'd like to change that so that it attaches an Excel sheet of that same data to the email instead of inserting a table within the email body. I'm not sure how to alter the code to do that.
Can someone help with how to update this?
Here is the code:
Sub DCMEmailReviewVBA()
Dim rst As DAO.Recordset
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim rst2 As DAO.Recordset
Dim strTableBeg As String
Dim strTableBody As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strTableHeader As String
Dim strFntEnd As String
Set rst2 = CurrentDb.OpenRecordset("select distinct DCM_Email from tDCMEmailList")
rst2.MoveFirst
'Create e-mail item
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Do Until rst2.EOF
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Define format for output
strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
strTableEnd = "</table>"
strTableHeader = "<font size=3 face=" & Chr(34) & "Calibri" & Chr(34) & "><b>" & _
"<tr bgcolor=lightblue>" & _
"<TD align = 'left'>Card Type</TD>" & _
"<TD align = 'left'>Cardholder</TD>" & _
"<TD align = 'left'>ER or Doc No</TD>" & _
"<TD align = 'center'>Trans Date</TD>" & _
"<TD align = 'left'>Vendor</TD>" & _
"<TD align = 'right'>Trans Amt</TD>" & _
"<TD align = 'left'>TEM Activity Name or P-Card Log No</TD>" & _
"<TD align = 'left'>Status</TD>" & _
"<TD align = 'right'>Aging</TD>" & _
"</tr></b></font>"
strFntNormal = "<font color=black face=" & Chr(34) & "Calibri" & Chr(34) & " size=3>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM tEmailData where DCM_email='" & rst2!DCM_Email & "' Order by Cardholder, Card_Type asc")
rst.MoveFirst
'Build HTML Output for the DataSet
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = strTableBody & _
"<tr>" & _
"<TD align = 'left'>" & rst!Card_Type & "</TD>" & _
"<TD align = 'left'>" & rst!Cardholder & "</TD>" & _
"<TD align = 'left'>" & rst!ERNumber_DocNumber & "</TD>" & _
"<TD align = 'center'>" & rst!Trans_Date & "</TD>" & _
"<TD align = 'left'>" & rst!Vendor & "</TD>" & _
"<TD align = 'right'>" & Format(rst!Trans_Amt, "currency") & "</TD>" & _
"<TD align = 'left'>" & rst!ACTIVITY_Log_No & "</TD>" & _
"<TD align = 'left'>" & rst!Status & "</TD>" & _
"<TD align = 'right'>" & rst!Aging & "</TD>" & _
"</tr>"
rst.MoveNext
Loop
'rst.MoveFirst
strTableBody = strTableBody & strFntEnd & strTableEnd
'rst.Close
'Set rst2 = CurrentDb.OpenRecordset("select distinct ch_email from t_TCard_CH_Email")
'rst2.MoveFirst
Call CaptureDCMBodyText
With objMail
'Set body format to HTML
.To = rst2!DCM_Email
.BCC = gDCMEmailBCC
.Subject = gDCMEmailSubject
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & gDCMBodyText
.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"
.HTMLBody = .HTMLBody & gDCMBodySig
.SentOnBehalfOfName = "xxxx"
.Display
'.Send
End With
rst2.MoveNext
'Loop
Clean_Up:
rst.Close
rst2.Close
Set rst = Nothing
Set rst2 = Nothing
'Set dbs = Nothing
End Sub