I split the code into 2 functions as below. I am not sure how to call the first part in the second part. Oh, and BodyText is actually a string. Thanks for your help.
Function ReportOutlookBody()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Set db = CurrentDb
Dim BodyText As String
Dim OlApp As Outlook.Application
Dim ObjMail As Outlook.MailItem
Dim strTableBeg As String
Dim strTableBody As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strTableHeader As String
Dim strFntEnd As String
Dim lngID As Long
Dim strSQL As String
Dim mailaddress As Variant
Dim strSubject As String
Dim OApp As Object, OMail As Object, signature As String
'Define format for output
strTableBeg = "<br><br><table border=1 cellpadding=3 cellspacing=0>"
strTableEnd = "</table><BR><BR>Please be assured that we are making best efforts to optimize our supply resources, which should minimize any further delays."
strTableHeader = "<font size=3 face=" & Chr(34) & "Arial" & Chr(34) & "><b>" & _
"<tr bgcolor=lightblue>" & _
TD("Customer:") & _
TD("Ship-to:") & _
TD("Order Number:") & _
TD("Purchase Order:") & _
TD("Customer:") & _
TD("Product:") & _
TD("Requested Ship Date:") & _
TD("Plant Anticipated Date:") & _
"</tr></b></font>"
StrContent = StrContent & "Limit Changes: " & Forms!Main.lstorders.Column(1) & Chr(13)
strFntNnormal = "<font color=black face=" & Chr(34) & "Arial" & Chr(34) & " size=2>"
strFntEnd = "</font>"
Dim strList As String
Dim varItem As Variant
Dim i As Long
Set lst = Forms!Main!lstorders
If lst.MultiSelect Then
With lst
For i = 1 To lst.ListCount - 1
.Selected(i) = True
Next i
End With
End If
On Error GoTo 0
' now call the after update event of the listbox merely to check the cmdsend button caption
' Call lstorders_AfterUpdate
i = 0
With Forms!Main!lstorders
For Each varItem In Forms!Main!lstorders.ItemsSelected
strList = strList & Forms!Main!lstorders.Column(0, varItem) & ","
Next
If strList <> "" Then
strList = Left(strList, Len(strList) - 1)
strList = "(" & strList & ")"
strSQL = "SELECT * FROM tblTrucks WHERE [ID] IN " & strList & ";"
'(send e-mail)
Else
MsgBox ("Please select an order from the list.")
End If
End With
Set rst = CurrentDb.OpenRecordset(strSQL)
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = strTableBody & _
"<tr>" & _
TD(rst![Customer]) & _
TD(rst![Ship-to]) & _
TD(rst![Sales Doc]) & _
TD(rst![PO#]) & _
TD(rst![City]) & _
TD(rst![Mat Description]) & _
TD(rst![PlGI date]) & _
TD(rst![Plant Anticipated Date]) & _
"<tr>"
BodyText = "<HTML><BODY>Hi Team,<BR><BR>Below are the Late Notifications for today. Please send out an email to the customer through the Late Order Notification Database <BR></BODY></HTML>"
rst.MoveNext
Loop
strTableBody = strTableBody & strFntEnd & strTableEnd
rst.Close
Set rst = Nothing
End Function
Function SendeMail()
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
'Set body format to HTML
.To = ""
.Display
.Subject = "Late Order Notifications"
.HTMLBody = strFntNormal & BodyText & strTableBody & "<br>" & .HTMLBody
End With
Set OMail = Nothing
Set OApp = Nothing
End Function
