Private Sub cmdMail_3bc4_Click()
Dim mess_body As String, StrFile As String, strPath As String
Dim appOutLook As Object
Dim MailOutLook As Object
Dim rs2 As Recordset
Dim asEmail As String
Dim Yes As String
Dim strGreeting As String
Dim strGreeting1 As String
Dim strMsg As String
Dim sqlString As String
Dim strMsg1 As String
Dim sqlString1 As String
Dim asPostTable1 As String
Dim j As Integer
Dim aBody() As String
Dim lCnt As Long
Dim asPostTable As String
Dim i As Integer
Dim rowColor As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
strGreeting = "<b><i>Dear All,</i></b><br>" & vbNewLine & vbCrLf & "<br><i>Below is the summary of returns and dispatch status</i><br>" _
& "<b><i><br>Dispatch Summary<br></i></b>" _
sqlString = "SELECT * From Q_Dispatch_Summary"
rs.Open sqlString, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'-----------------------------------------------------------------------------
strMsg = "<table border='1' cellpadding='3' cellspacing='3' style='border-collapse: collapse' bordercolor='#111111' width='800'>" & _
"<tr>" & _
"<td bgcolor='#7EA7CC'> <b>Entry_Date</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>VIP_flag</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>LocationA</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>LocationB</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>LocationC</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>LocationD</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>LocationE</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>LocationF</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Total</b></td>" '& _
"</tr>"
i = 0
Do While Not rs.EOF
If (i Mod 2 = 0) Then
rowColor = "<td align=center bgcolor='#FFFFFF'> "
Else
rowColor = "<td align=center bgcolor='#E1DFDF'> "
End If
strMsg = strMsg & "<tr>" & _
rowColor & Nz(rs.Fields("Entry_Date"), "") & "</td>" & _
rowColor & Nz(rs.Fields("VIP_flag"), "") & "</td>" & _
rowColor & Nz(rs.Fields("LocationA"), "") & "</td>" & _
rowColor & Nz(rs.Fields("LocationB"), "") & "</td>" & _
rowColor & Nz(rs.Fields("LocationC"), "") & "</td>" & _
rowColor & Nz(rs.Fields("LocationD"), "") & "</td>" & _
rowColor & Nz(rs.Fields("LocationE"), "") & "</td>" & _
rowColor & Nz(rs.Fields("LocationF"), "") & "</td>" & _
rowColor & Nz(rs.Fields("Total"), "") & "</td>" & _
"</tr>"
rs.MoveNext
i = i + 1
Loop
strMsg = strMsg & "</table>"
'---------------------------------------------------------------------------
asPostTable = "<br><b><i>Thanks and Regards</i></b><br>"
'----------------------------------------------------------------------------
Dim rs1 As ADODB.Recordset
Set rs1 = New ADODB.Recordset
sqlString1 = "SELECT * From Q_Returns_Summary"
rs1.Open sqlString1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'-----------------------------------------------------------------------------
strMsg1 = "<table border='1' cellpadding='3' cellspacing='3' style='border-collapse: collapse' bordercolor='#111111' width='800'>" & _
"<tr>" & _
"<td bgcolor='#7EA7CC'> <b>Entry_Date</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>VIP_flag</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Source</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Deleted</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Received</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Rejected</b></td>" & _
"<td bgcolor='#7EA7CC'> <b>Returned</b></td>" '& _
"</tr>"
j = 0
Do While Not rs1.EOF
If (j Mod 2 = 0) Then
rowColor = "<td align=center bgcolor='#FFFFFF'> "
Else
rowColor = "<td align=center bgcolor='#E1DFDF'> "
End If
strMsg1 = strMsg1 & "<tr>" & _
rowColor & Nz(rs1.Fields("Entry_Date"), "") & "</td>" & _
rowColor & Nz(rs1.Fields("VIP_flag"), "") & "</td>" & _
rowColor & Nz(rs1.Fields("Source"), "") & "</td>" & _
rowColor & Nz(rs1.Fields("Deleted"), "") & "</td>" & _
rowColor & Nz(rs1.Fields("Received"), "") & "</td>" & _
rowColor & Nz(rs1.Fields("Rejected"), "") & "</td>" & _
rowColor & Nz(rs1.Fields("Returned"), "") & "</td>" & _
"</tr>"
rs1.MoveNext
j = j + 1
Loop
strMsg1 = strMsg1 & "</table>"
'---------------------------------------------------------------------------
asPostTable1 = "<br><b><i>Returns Summary</i></b><br>"
'----------------------------------------------------------------------------
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(0)
Set rs2 = CurrentDb.OpenRecordset("Select * from Mail where Mail.Summary_chk=Yes")
'~~> Change path here
strPath = "E:\Test Folder1\Reports\"
With MailOutLook
asEmail = ""
Do While Not rs2.EOF
asEmail = asEmail & rs2.Fields("email_ID").Value & "; "
rs2.MoveNext
Loop
.To = asEmail
If asEmail = "" Then
MsgBox "NO recipients selected!!!"
Exit Sub 'Exit the sub routine.
End If
.Subject = "Summary Report for date: " & Format(Date, "dd-mm-yyyy")
.HTMLBody = strGreeting & strMsg & asPostTable1 & strMsg1 & asPostTable
'~~> *.* for all files
StrFile = Dir(strPath & "*.*")
Do While Len(StrFile) > 0
.Attachments.Add strPath & StrFile
StrFile = Dir
Loop
'.DeleteAfterSubmit = True
'.Display
.Send
End With
MsgBox "Reports have been sent", vbOKOnly
End Sub