在 VBA 中引用查询以发送多封电子邮件

Posted 2023-04-19

【中文标题】在 VBA 中引用查询以发送多封电子邮件

【英文标题】：Referencing Query in VBA for Sending Multiple Emails

【发布时间】：2019-10-27 11:12:28

【问题描述】：

我使用 Access 数据库通过 Outlook 发送多封电子邮件的代码。

我想按电子邮件条件搜索查询，并使用这些过滤电子邮件来发送电子邮件，但我的 VBA 代码存在以下问题：

“Query1.RecordCount”的“方法未找到”

Private Sub outlook_Click()
Dim ooutlook As outlook.Application
Dim oEmailitem As outlook.MailItem
Dim rs As Recordset
Dim emaillist As String
Dim Query As String
Dim Query1 As QueryDef
If ooutlook Is Nothing Then
    Set ooutlook = New outlook.Application
End If
Set oEmailitem = ooutlook.CreateItem(olMailItem)
With oEmailitem
Query = "QryStudentAddressDetails"
        Set Query1 = CurrentDb.QueryDefs(Query)
        If Query1.RecordCount > 0 Then
        rs.MoveFirst
        Do Until rs.EOF
            If IsNull(rs![Email_Address]) Then
            rs.MoveNext
            Else
                emaillist = emaillist & rs![Email_Address] & ";"
                .To = emaillist
                rs.MoveNext
            End If
        Loop
        Else
        `enter code here`MsgBox "No one has Email Address!"
        End If
        Set rs = Nothing
    .CC = ""
    .Subject = "testing email"
    .Display
    End With
    Set oEmailitem = Nothing
    Set ooutlook = Nothing


End Sub

【参考方案1】：

A QueryDef object does not have a RecordCount property; RecordCount 是 RecordSet 或 TableDef 对象的属性。

因此，我建议将您的代码修改为以下内容：

Private Sub outlook_Click()

    Dim cdb As DAO.Database
    Dim rst As DAO.Recordset
    Dim ola As Outlook.Application
    Dim olm As Outlook.MailItem
    Dim rcp As String

    Set cdb = CurrentDb
    Set rst = cdb.OpenRecordset("QryStudentAddressDetails")

    If Not rst.EOF Then
        rst.MoveFirst
        Do Until rst.EOF
            If Not IsNull(rst!Email_Address) Then
                rcp = rcp & rst!Email_Address & ";"
            End If
            rst.MoveNext
        Loop
    End If
    rst.Close

    If rcp <> vbNullString Then
        Set ola = New Outlook.Application
        Set olm = ola.CreateItem(olMailItem)
        With olm
            .to = rcp
            .Subject = "Testing Email"
            .Display
        End With
        Set olm = Nothing
        Set ola = Nothing
    End If
End Sub

以上内容完全未经测试，但希望能让您朝着正确的方向前进。

【讨论】：

谢谢兄弟。我在代码中遇到错误（searchlist.list）。列表成员或方法未找到我应该怎么做

@MubashirSheheryar 您引用的错误不是我发布的代码的一部分 - 因此它必须来自您项目的其他地方。

【参考方案2】：

更改这些行并重试

Private Sub outlook_Click()
Dim oOutlook As Outlook.Application
Dim oEmailitem As Outlook.MailItem
Dim rs As Recordset
Dim emaillist As String
Dim Query As String
Dim Query1 As Recordset '  <-------------- Change
If oOutlook Is Nothing Then
    Set oOutlook = New Outlook.Application
End If
Set oEmailitem = oOutlook.CreateItem(olMailItem)
With oEmailitem
Query = "QryStudentAddressDetails"
        Set Query1 = CurrentDb.OpenRecordset(Query, dbOpenSnapshot) '  <--------------- Change
        If Query1.RecordCount > 0 Then
        rs.MoveFirst
        Do Until rs.EOF
            If IsNull(rs![Email_Address]) Then
            rs.MoveNext
            Else
                emaillist = emaillist & rs![Email_Address] & ";"
                .To = emaillist
                rs.MoveNext
            End If
        Loop
        Else
        ' enter code here`MsgBox "No one has Email Address!"
        End If
        Set rs = Nothing
    .CC = ""
    .Subject = "testing email"
    .Display
    End With
    Set oEmailitem = Nothing
    Set oOutlook = Nothing
End Sub

【讨论】：

设置Query1 = CurrentDb.OpenRecordset(Query) 参数太少错误

试试Set Query1 = CurrentDb.OpenRecordset(Query, dbOpenSnapshot)