Below is the code I am using, trying to define a second table and then add to the email body, but cannot figure it out.
Also - where in the code should I include HTML tags in order to format the tables.
Private Sub Command234_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 9) As String
Dim aRow(1 To 9) As String
Dim aBody() As String
Dim lCnt As Long
'Create the header row
aHead(1) = "Date"
aHead(2) = "Line"
aHead(3) = "Act"
aHead(4) = "Sched"
aHead(5) = "Var"
aHead(6) = "%ofSched"
aHead(7) = "Fcst"
aHead(8) = "Vpe"
aHead(9) = "%Fcst"
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 qry_prodstatusdailyfinal.[Proddate], qry_prodstatusdailyfinal.[Line], qry_prodstatusdailyfinal.[Act], qry_prodstatusdailyfinal.[Sched], qry_prodstatusdailyfinal.[Var], qry_prodstatusdailyfinal.[%ofSched] , qry_prodstatusdailyfinal.[fcst] , qry_prodstatusdailyfinal.[vpe] , qry_prodstatusdailyfinal.[%fcst] " & _
"FROM qry_prodstatusdailyfinal " & ""
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("ProdDate")
aRow(2) = rec("Line")
aRow(3) = Nz(rec("Act"), "")
aRow(4) = rec("Sched")
aRow(5) = Nz(rec("Var"), "")
aRow(6) = rec("%ofSched")
aRow(7) = rec("Fcst")
aRow(8) = Nz(rec("Vpe"), "")
aRow(9) = rec("%Fcst")
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 = "CVL Daily External"
olItem.Subject = "Attainment CVL"
olItem.HTMLBody = Join(aBody, vbNewLine)
olItem.Display
End Sub
Also - where in the code should I include HTML tags in order to format the tables.
Private Sub Command234_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 9) As String
Dim aRow(1 To 9) As String
Dim aBody() As String
Dim lCnt As Long
'Create the header row
aHead(1) = "Date"
aHead(2) = "Line"
aHead(3) = "Act"
aHead(4) = "Sched"
aHead(5) = "Var"
aHead(6) = "%ofSched"
aHead(7) = "Fcst"
aHead(8) = "Vpe"
aHead(9) = "%Fcst"
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 qry_prodstatusdailyfinal.[Proddate], qry_prodstatusdailyfinal.[Line], qry_prodstatusdailyfinal.[Act], qry_prodstatusdailyfinal.[Sched], qry_prodstatusdailyfinal.[Var], qry_prodstatusdailyfinal.[%ofSched] , qry_prodstatusdailyfinal.[fcst] , qry_prodstatusdailyfinal.[vpe] , qry_prodstatusdailyfinal.[%fcst] " & _
"FROM qry_prodstatusdailyfinal " & ""
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("ProdDate")
aRow(2) = rec("Line")
aRow(3) = Nz(rec("Act"), "")
aRow(4) = rec("Sched")
aRow(5) = Nz(rec("Var"), "")
aRow(6) = rec("%ofSched")
aRow(7) = rec("Fcst")
aRow(8) = Nz(rec("Vpe"), "")
aRow(9) = rec("%Fcst")
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 = "CVL Daily External"
olItem.Subject = "Attainment CVL"
olItem.HTMLBody = Join(aBody, vbNewLine)
olItem.Display
End Sub
