アクセス2007には約150ページのサプライヤーのレポートがあります。各レポートには、ページごとに住所、電子メールの連絡先、電話番号、製品、会社名が含まれています。月に一度、担当者の住所、電話番号、製品の変更を確認するために、サプライヤーに電子メールを送信する必要があります。
レポート全体ではなく、その特定の電子メールにその特定のレポートを送信したいと思います。これを自動化してほしい。
ネットで調べた後、VBAでコードを記述しましたが、まだ機能していません。パラメータが多すぎます。予想される1.エラー。
以下は、[レポートの送信]ボタンが付いたフォームのコードです。
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
次のコードのモジュールがあります
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
レポートであるクエリは、そのデータを取得しています。次の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));
私が間違っているところに固執しているので助けてください。