Access 2007 VBA Report email per company - ms-access

Question

I have a suppliers' report about 150 pages in access 2007. Each report has address, emails contact person, phone number, products and name of company per page. Once a month I have to send an email to the suppliers to confirm changes of contact person address, phone number and products.
I want to send that particular report to that particular email not the whole report.
I want this to be automated.
I have written code in VBA after research on the net and still not working. I am getting Too many parameters. Expected 1. Error.
Below is code for my form with a Send Report button.
Dim strSql As String
Dim strSubject As String
Dim strMsgBody As String
strSql = "SELECT DISTINCT Name, EMail FROM [Suppliers and Products]"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSql)
'loop through the recordset
Do While Not rst.EOF
' grab email string
strEmail = rst.Fields("EMail")
' grab name
strName = rst.Fields("Name")
Call fnUserID(rst.Fields("EMail"))
'send the pdf of the report to curent supplier
On Error Resume Next
strSubject = "September 2012 Supplier's Listing"
strMsgBody = "2008 Procedure Review Attached"
DoCmd.SendObject acSendReport, "Suppliers Confirmation forms", acFormatHTML, strEmail, , , strSubject, strMsgBody, False
If Err.Number <> 0 Then
MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "Delivery Failure to the following email address: " & strEmail
End If
On Error GoTo PROC_ERR
' move and loop
rst.MoveNext
Loop
' clean up
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
PROC_Exit:
Exit Sub
PROC_ERR:
MsgBox Err.Description
Resume PROC_Exit
I have a module with the following code
Option Compare Database
Public Function fnUserID(Optional Somevalue As Variant = Null, Optional reset As Boolean = False) As Variant
Static EMail As Variant
If reset Or IsEmpty(EMail) Then EMail = Null
If Not IsNull(Somevalue) Then EMail = Somevalue
fnUserID = EMail
End Function
Public Function SendReportByEmail(strReportName As String, strEmail As String)
On Error GoTo PROC_ERR
Dim strRecipient As String
Dim strSubject As String
Dim strMessageBody As String
'set the email variables
strRecipients = strEmail
strSubject = Reports(strReportName).Caption
strMessageBody = "May 2012 Suppliers' List "
' send report as HTML
DoCmd.SendObjectac acSendReport, strReportName, acFormatHTML, strRecipients, , , strSubject, strMessageBody, False
SendReportByEmail = True
PROC_Exit:
Exit Function
Proc Err:
SendReportByEmail = False
If Err.Number = 2501 Then
Call MsgBox("The email was not sent for " & strEmail & ".", vbOKOnly + vbExclamation + vbDefaultButton1, "User Cancelled Operation")
Else: MsgBox Err.Description
End If
Resume PROC_Exit
End Function
The query which is report is getting its data has the following SQL.
SELECT Names.Name, Names.Phys_Address,
Names.Telephones, Names.Fax, Names.EMail,
Names.Web, Names.Caption AS Expr1, [Products by Category].CatName,
[Products by Category].ProdName
FROM [Names]
INNER JOIN [Products by Category]
ON Names.SuppID=[Products by Category].SupID
WHERE ((Names.EMail = fnUserID()) or (fnUserID() Is Null));
Please help as I am stuck to where I am going wrong.

Answer 1

Some notes.
On Error GoTo PROC_ERR
Dim qdf As QueryDef
Dim strSQL As String
Dim strSubject As String
Dim strMsgBody As String
strSQL = "SELECT DISTINCT [Name], EMail, SuppID FROM Names " _
& "INNER JOIN [Products by Category] " _
& "ON Names.SuppID=[Products by Category].SupID "
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSql)
qrySQL = "SELECT Names.Name, Names.Phys_Address, " _
& "Names.Telephones, Names.Fax, Names.EMail, " _
& "Names.Web, Names.Caption AS Expr1, " _
& "[Products by Category].CatName, " _
& "[Products by Category].ProdName " _
& "FROM [Names] " _
& "INNER JOIN [Products by Category] " _
& "ON Names.SuppID=[Products by Category].SupID "
'loop through the recordset
Do While Not rst.EOF
' grab email string
strEmail = rst.Fields("EMail")
' grab name
strName = rst.Fields("Name")
' You should check that the email is not null
Call fnUserID(rst.Fields("EMail"))
'send the pdf of the report to curent supplier
'On Error Resume Next
'The query that the report uses
Set qdf = CurrentDB.QueryDefs("Suppliers and Products")
qdf.SQL = qrySQL & " WHERE SuppID=" & rst!SuppID
strSubject = "September 2012 Supplier's Listing"
strMsgBody = "2008 Procedure Review Attached"
DoCmd.SendObject acSendReport, "Suppliers Confirmation forms", _
acFormatHTML, strEmail, , , strSubject, strMsgBody, False
' move and loop
rst.MoveNext
Loop
''Reset the query
qdf.SQL = qrySQL
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
PROC_Exit:
Exit Sub
PROC_ERR:
If Err.Number <> 0 Then
MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, _
"Delivery Failure to the following email address: " & strEmail
End If
MsgBox Err.Description
Resume PROC_Exit