所以我使用按钮来运行查询,然后将选定的电子邮件拉入电子邮件。有一个单一的功能,然后每个按钮发送相应的查询来充当记录集
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
按钮所在的表单所有查询只需在访问中单击它即可正确运行,并且所有排列查询都可以正确运行。我从它的 SQL 语句中取出标准,看看它是否会运行并且确实如此。该条件与表单上的组合框选择相匹配。下面是 Arrangements 按钮的 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]);
我认为这可能与我在 rs.open 行中打开查询的方式有关,并且我需要调用条件而不仅仅是在 SQL 语句中?对此问题或解决方案的任何帮助将不胜感激。
编辑
所以我用 DAO 把我的代码改成了这个,看看是否能解决这个问题。我现在在线上Set rs = db.OpenRecordset(strQueryname)
出现错误错误
我已经对以前的方式进行了评论,因此如果提供了解决方案,我可以随时改回来。
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 的完成方式可能存在问题,被中途参数化或只是做错了。
您的尝试存在几个问题:
命名对象:使用 ADO 调用保存的查询,Recordset.Open
该查询主要需要 SQL 语句或命令对象,而不是命名对象。因此,您的第一个错误的原因。相反,使用Conn.Execute
which 将标准 SQL 语法添加到命名对象。SELECT * FROM
或者,使用查询对象显式传递。这不是 DAO 记录集的问题(专门针对 MS Access 对象模型的库,而 ADO 则适用于任何后端)。
参数:在看不到表单值的后端查询中使用表单控件值。任何未使用DoCmd
like OpenQuery
(对于选择查询)或RunSQL
(对于操作查询)运行的查询都无法识别表单控件。因此,第二个错误的原因。而不是Forms!MyForm!MyControl
使用ADO Command 参数或DAO QueryDefs 参数。在我的[vba]
标签答案中搜索无数 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 用户定义的函数也不会被识别。
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句