CODEWITHSUNDEEP
vbams-access
RJBJR
RJBJR

Reputation: 25

Filter Recordset in SQL

I have a MS Access module that creates Outlook emails to suppliers in our company in a HTML Table. I can make the module create an email for every customer but I can not get the data to filter out to each individual company. For example the module creates a email for "Supplier A" but it still shows "Supplier B" and "Supplier C" results in that email. My current attempt is opening a recordset and using it as SQL Criteria, I although keep getting the error "No value given for one or more required parameters". Any help or direction on what I'm doing wrong is greatly appreciated.


Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Dim strMsg As String
Dim strbody As String
Dim sqlmsg As String
Dim i As Integer
Dim rowColor As String
Dim strsup As String
Dim supfilter As DAO.Recordset
Dim db As DAO.Database
Dim Maillist As DAO.Recordset
Dim Mailset As DAO.QueryDef


DoCmd.SetWarnings False
Set db = CurrentDb

Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Set Maillist = db.OpenRecordset("P086 - Email OOR")
Set Mailset = db.QueryDefs("P086 - SOOR Email Format")

sqlmsg = "SELECT [P086 -  Supplier Open Order Report].[Purchase Order ID], [P086 -  Supplier Open Order Report].[PO#] AS [STC Job#], Format([Date],""mm/dd/yyyy"") AS [Issued Date], [P086 -  Supplier Open Order Report].Supplier, [P086 -  Supplier Open Order Report].Quantity, [P086 -  Supplier Open Order Report].DeliveryDate AS [Delivery Date], [P086 -  Supplier Open Order Report].StatDate AS [Stat Date], [P086 -  Supplier Open Order Report].[Till Delivery], [P086 -  Supplier Open Order Report].[Quantity In]" _
        & " From [P086 -  Supplier Open Order Report]" _
        & " WHERE [P086 -  Supplier Open Order Report].Supplier = '" & Maillist.Fields("Supplier") & "'" _
        & " ORDER BY [P086 -  Supplier Open Order Report].DeliveryDate;"


rs.Open sqlmsg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

strMsg = "<table border='1' cellpadding='3' cellspacing='3' style='border-collapse: collapse' bordercolor='#111111' width='800'>" & _
"<tr>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Purchase Order</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>STC Job#</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Issue Date</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Supplier</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Quantity</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Quantity Received</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Delivery Date</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Stat Date</b></td>" & _
"<td bgcolor='#B0C4DE'>&nbsp;<b>Days Till Delivery</b></td>" & _
"</tr>"

i = 0

Do While Not rs.EOF

If (i Mod 2 = 0) Then
rowColor = "<td bgcolor='#FFFFFF'>&nbsp;"
Else
rowColor = "<td bgcolor='#E1DFDF'>&nbsp;"
End If

Mailset.SQL = sqlmsg

strMsg = strMsg & "<tr>" & _
rowColor & rs.Fields("Purchase Order ID") & "</td>" & _
rowColor & rs.Fields("STC Job#") & "</td>" & _
rowColor & rs.Fields("Issued Date") & "</td>" & _
rowColor & rs.Fields("Supplier") & "</td>" & _
rowColor & rs.Fields("Quantity") & "</td>" & _
rowColor & rs.Fields("Quantity In") & "</td>" & _
rowColor & rs.Fields("Delivery Date") & "</td>" & _
rowColor & rs.Fields("Stat Date") & "</td>" & _
rowColor & rs.Fields("Till Delivery") & "</td>" & _
"</tr>"

rs.MoveNext
Maillist.MoveNext
i = i + 1
Loop

strbody = Chr(12) & "The Raw Material Auto Order Screen Must Have the 5000 Serial Number Inserted To Be Remove From This Alert." & _
             Chr(12) & "Raw Material QM34 Process Sheets Required For All Inventory Purchases. Stock Number(s) Are Provided In This Email."


strMsg = strMsg & "</table>" & strbody
Set olApp = Outlook.Application
Set Maillist = db.OpenRecordset("P086 - Email OOR")

Do Until Maillist.EOF

Set objMail = olApp.CreateItem(olMailItem)
objMail.To = Maillist("emailaddress")

With objMail
.BodyFormat = olFormatHTML
.HTMLBody = "<Font size =""3"">" & strMsg & "</font>"
.Subject = "Supplier Open Order Report " & Date
'.Send 'if you want to send it directly without displaying on screen
.Display ' to display on screen before send
End With
Maillist.MoveNext
Loop

Set olApp = Nothing
Set objMail = Nothing

End Function

Upvotes: 1

Views: 86

Answers (1)

June7
June7

Reputation: 21370

Criteria for text type fields require delimiters. Options are apostrophe or doubled quote marks. I prefer apostrophe as it is easier to read. A date/time field would need # delimiter.

& " WHERE [P086 - Supplier Open Order Report].Supplier = '" & Maillist!Supplier & "'" _

Don't need all those parens, don't need to concatentate empty string, don't need .Fields - alternative syntax for referencing field.

For more info, review INSERT INTO - errors, but allows input into table

As for data that is sent, it is compiled only once outside recordset Maillist loop. Code logic is wrong. Modify procedure to compile data for each Maillist record within its loop. Also, really need to create Outlook application object only once so do that and close it outside loops. The email object is different.

Set olApp = Outlook.Application
Set Maillist = db.OpenRecordset("P086 - Email OOR")
Do Until Maillist.EOF
    sqlmsg = ...
    rs.Open sqlmsg, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    ...
    Do While Not rs.EOF
        ...
    Loop
    rs.Close
    ...
Loop

Remove the second Set Maillist = db.OpenRecordset("P086 - Email OOR").

Upvotes: 1

Related Questions