This is my first post and I have a limited amount of knowledge of VBA so please bear with me, lol. I am needing to create a script that will allow me to pull from two tables and send 1 message that includes the results in two separate grids. I have the code that will allow for one table, but I don't know how to get it done for the second. Below is the working code.
Code:
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 2) As String
Dim aRow(1 To 2) As String
Dim aBody() As String
Dim lCnt As Long
'Create the header row
aHead(1) = "Driver Name"
aHead(2) = "Expiration Date"
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 Email_Query"
Set db = CurrentDb
Set rec = CurrentDb.OpenRecordset("CDL60DayExp")
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("Name")
aRow(2) = rec("CdlExp")
aBody(lCnt) = "<tr><td>" & Join(aRow, "</td><td>") & "</td></tr>"
rec.MoveNext
Loop
End If
aBody(lCnt) = "Hello," & "<br>" & _
"<br>" & _
"Below are the drivers with upcoming expirations" & "<br>" & _
"<br>" & _
aBody(lCnt) & "</table></body></html>"
'create the email
Set olApp = CreateObject("Outlook.application")
Set olItem = olApp.CreateItem(0)
olItem.display
olItem.To = "swmyers@nutrablend.net"
olItem.Subject = "Upcoming Expirations"
olItem.HTMLBody = Join(aBody, vbNewLine)
olItem.display
