Private Sub Command104_Click()
Dim db As DAO.Database
Set db = CurrentDb
Dim msgtxt As String
Dim Summary As String
Dim Destination As String
Dim Sbject As String
Dim CarbonCopy As String
'Dim objOutlook As Outlook.Application
'Dim objEmail As Outlook.MailItem
Dim rs As DAO.Recordset
SQL = "SELECT Main_PIP_TBL.Account, Main_PIP_TBL.Amount, Main_PIP_TBL.PPM_Code, Main_PIP_TBL.Pay_Date, Main_PIP_TBL.Pay_Month, Main_PIP_TBL.Starts_On, Main_PIP_TBL.Ends_On, Main_PIP_TBL.Funding, Main_PIP_TBL.Delete, Main_PIP_TBL.Update, Main_PIP_TBL.Add_Date, Main_PIP_TBL.Update_Date, Main_PIP_TBL.Cancel_Date, Main_PIP_TBL.Associate_Name FROM Main_PIP_TBL;"
Set rs = db.OpenRecordset(SQL)
Do While Not rs.EOF
msgtxt = "Please see the below information regarding PIPS for processing.<br>" & _
"Please contact the AMS Cash Operations department with any questions. <b><font color=red>" & test & "</font></b><br><br><br>" & _
"" & rs.Fields(0) & " " & rs.Fields(1) & " " & rs.Fields(2) & " " & rs.Fields(3) & " " & rs.Fields(4) & " " & rs.Fields(5) & " " & rs.Fields(6) & " " & rs.Fields(7) & "<br><br>" & _
"Regards,<br>AMS Cash Operations<br>Extension 74530<br><br>"
rs.MoveNext
loop
Destination = "Tallman@blah.com"
Sbject = "Testing for the PIP Database!!!"
'CarbonCopy = " "
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
' .FlagDueBy = DateAdd("w", 2, Now()) 'this gives a two day reminder
' .Importance = olImportanceHigh
.To = Destination
'.CC = CarbonCopy
.Subject = Sbject
.HTMLBody = msgtxt
.Display
' .send
End With
End Sub