将参数设置为 VBA 和 SQL 使用 DAO 查询

Question

所以我使用按钮运行查询，然后将所选电子邮件提取到电子邮件中。这个有一个单一的功能，然后每个按钮发送相应的查询作为记录集

Sub EmailQuery(strQueryName As String)

'On Error GoTo Err_EmailRequery_Click

    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim strEmail As String

    Set cn = CurrentProject.Connection
    Set rs = New ADODB.Recordset

    rs.Open strQueryName, cn
    
    With rs
    .MoveLast
    .MoveFirst

        Do While Not .EOF
            strEmail = strEmail & .Fields("Email") & ";"
            .MoveNext
        Loop
        .Close
    End With
    
    strEmail = Left(strEmail, Len(strEmail) - 1)
    
    DoCmd.SendObject , , , , , strEmail, , , True, False
    
'Exit_EmailRequery_Click:
'
'    Exit Sub
'
'Err_EmailRequery_Click:
'
'    MsgBox Err.Description
'
'    Resume Exit_EmailRequery_Click

End Sub


Private Sub cmdActive_Click()

    EmailQuery ("qryActiveSuppliers")
    
End Sub

Private Sub cmdAllSuppliers_Click()
    
    EmailQuery ("qryAllSuppliers")

End Sub

Private Sub cmdArrangements_Click()
    
    EmailQuery ("qryAgreementEmail")

End Sub

Private Sub cmdInactive_Click()
    
    EmailQuery ("qryInactiveSuppliers")

End Sub

Form where the buttons are located 只需在访问中单击它，所有查询运行都正确，所有栏安排查询运行正确。我从它的 SQL 语句中取出标准，看看它是否会运行并且确实如此。该条件与表单上的组合框选择相匹配。以下是“安排”按钮的 SQL 语句。

SELECT DISTINCT tblSuppliers.SupplierName, Nz([BusinessEmail],[PersonalEmail]) AS Email
FROM ((tblSuppliers 
INNER JOIN tblSuppliersAgreements ON tblSuppliers.ID = tblSuppliersAgreements.SupplierID) 
INNER JOIN tblContacts ON tblSuppliers.ID = tblContacts.SupplierID)
WHERE ((tblSuppliersAgreements.AgreementID)=[Forms]![frmMainMenu]![cboAgreement]);

This is the error I am getting when I try to click the button to run it

我认为这可能与我在 rs.open 行中打开查询的方式有关，我需要调用条件而不仅仅是在 SQL 语句中？非常感谢对此问题或解决方案的任何帮助。

编辑

所以我用 DAO 将我的代码更改为这个，看看是否可以解决问题。我现在在行 Set rs = db.OpenRecordset(strQueryname) 上收到错误 The error

我已经留下了以前的评论方式，所以如果提供了解决方案，我可以随时改回来。

Sub EmailQuery(strQueryName As String)

'On Error GoTo Err_EmailRequery_Click

'    Dim cn As ADODB.Connection
'    Dim rs As ADODB.Recordset
    Dim strEmail As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set rs = db.OpenRecordset(strQueryName)

'    Set cn = CurrentProject.Connection
'    Set rs = New ADODB.Recordset

    MsgBox strQueryName
    
'    rs.Open strQueryName, cn
    
    With rs
'    .MoveLast
'    .MoveFirst

        Do While Not .EOF
            strEmail = strEmail & .Fields("Email") & ";"
            .MoveNext
        Loop
        .Close
    End With
    
    strEmail = Left(strEmail, Len(strEmail) - 1)
    
    DoCmd.SendObject , , , , , strEmail, , , True, False
    
'Exit_EmailRequery_Click:
'
'    Exit Sub
'
'Err_EmailRequery_Click:
'
'    MsgBox Err.Description
'
'    Resume Exit_EmailRequery_Click

End Sub

编辑 2

主函数中的当前代码

Sub EmailQuery(strQueryName As String)

'On Error GoTo Err_EmailQuery_Click

    Dim strEmail As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set rs = db.OpenRecordset(strQueryName)

    MsgBox strQueryName
    
    With rs
'    .MoveLast
'    .MoveFirst
        Do While Not .EOF
            strEmail = strEmail & .Fields("Email") & ";"
            .MoveNext
        Loop
        .Close
    End With
    
    strEmail = Left(strEmail, Len(strEmail) - 1)
    
    DoCmd.SendObject , , , , , strEmail, , , True, False
    
'Exit_EmailQuery_Click:
'
'    Exit Sub
'
'Err_EmailQuery_Click:
'
'    MsgBox Err.Description
'
'    Resume Exit_EmailQuery_Click

End Sub

当前SQL

PARAMETERS [PrmID] Long;
SELECT DISTINCT tblSuppliers.SupplierName, IIf( IsNull(BusinessEmail) , PersonalEmail, BusinessEmail) AS Email
FROM (tblSuppliers 
INNER JOIN tblSuppliersAgreements ON tblSuppliers.ID = tblSuppliersAgreements.SupplierID) 
INNER JOIN tblContacts ON tblSuppliers.ID = tblContacts.SupplierID
WHERE ((tblSuppliersAgreements.AgreementID)=[PrmID]);

我知道 SQL 的完成方式可能存在问题，参数化一半或只是做错了。

Answer 1

你的尝试有几个问题：

命名对象：使用 ADO Recordset.Open 调用已保存的查询，主要需要 SQL 语句或命令对象而不是命名对象.因此，您的第一个错误的原因。相反，使用 Conn.Execute 将标准 SQL 语法添加到命名对象。或者显式传递 SELECT * FROM 与查询对象。这不是 DAO 记录集的问题（专门针对 MS Access 对象模型的库，而 ADO 是针对 any 后端进行概括的）。

参数：在看不到表单值的后端查询中使用表单控件值。任何非运行且 DoCmd 的查询，例如 OpenQuery（对于 select 查询）或 RunSQL（对于操作查询），都无法识别表单控件。因此，第二个错误的原因。使用 ADO Command parameters or DAO QueryDefs parameters 而不是 Forms!MyForm!MyControl。搜索 my [vba] tag answers 无数的 ADO 或 DAO 参数解决方案。请参阅下面的用例：

Sub EmailQuery(strQueryName As String)
On Error GoTo Err_EmailQuery_Click
    Dim strEmail As String
    Dim db As DAO.Database
    Dim qdef As DAO.QueryDef
    Dim rs As DAO.Recordset

    Set db = CurrentDb
    Set qdef = db.QueryDefs(strQueryName)

    With qdef
        ' BIND PARAMETER
        .Parameters("PrmID") = [Forms]![frmMainMenu]![cboAgreement]
        ' OPEN RECORDSET
        Set rs = .OpenRecordset()
    End With

    '...loop and email...

Exit_EmailQuery_Click:
    rs.Close
    Set rs = Nothing: Set qdef = Nothing: Set db = Nothing
Exit Sub

Err_EmailQuery_Click:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume Exit_EmailQuery_Click
End Sub

特殊功能: 运行只有 MS Access GUI 方法像 NZ 在不识别此类功能的后端查询中。如果您解决以上两个问题，您将运行进入此错误。使用 IIF + ISNULL/IS NULL。同样，VBA user-defined 函数将无法识别。

将参数设置为 VBA 和 SQL 使用 DAO 查询

Setting Parameters to VBA and SQL Query using DAO

sql

ms-access

vba