访问每个公司的 2007 VBA 报告电子邮件

Posted 2023-04-19

【中文标题】访问每个公司的 2007 VBA 报告电子邮件

【英文标题】：Access 2007 VBA Report email per company

【发布时间】：2012-05-31 07:33:30

【问题描述】：

我有一份 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

report 正在获取其数据的查询具有以下 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));

请帮忙，因为我被困在哪里出错了。

【问题讨论】：

您使用 Name 作为字段名称，这是一个非常糟糕的主意。这是一个reserved word，随着你的进展会导致越来越多的问题。总是缩进你的代码。避免使用On error Resume Next，它掩盖了问题，几乎不是一个好主意。

您的报告会自行打开吗？哪一行给出了错误？注释掉你的错误编码，这样你就会得到一个失败的行。

数据库已经创建。其中一个字段是名称。该报告不会在其上打开。我创建了它，它只有一个发送按钮和我发布的代码。

Set rst = dbs.OpenRecordset(strSql) 错误 3601：参数太少。预期为 1。

如果您指的是SELECT DISTINCT Name, EMail FROM [Suppliers and Products]这一行，请将其粘贴到查询设计窗口的 SQL 视图中，然后切换到设计视图并查看它的内容。

【参考方案1】：

一些笔记。

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

【讨论】：

我已经实现了代码。非常感谢你。变量 qdf 给了我一个错误。我应该将其声明为什么？

糟糕，应该是Set qdf，qdf 可以声明为 QueryDef (DAO)

非常感谢。但是，发送的表格没有数据。它有标签，即地址电话传真电子邮件和网络没有与之相关的字段。

您的报告所依据的查询名称是什么？在示例中，它被称为Suppliers and Products。此查询的 sql 更改为仅引用特定供应商。打开查询，看看是否有任何结果，如果没有，请尝试将供应商 ID 更改为您知道有结果的供应商 ID。如果可行，请将第一个记录集更改为仅选择有结果的供应商。

我确实打开了查询，它也有结果和报告。令我惊讶的是，当重新检查查询已更改并添加了 WHERE SuppID=150;现在当我运行它时它是空的。我有 SuppID = 150。实际上 SuppID 从 1 开始到 197。