Ссылка на запрос в VBA для отправки нескольких электронных писем

Question

Я пишу код для отправки нескольких электронных писем через Outlook, используя базу данных Access.

Я хочу выполнить поиск по критерию для писем и использовать эти фильтры для отправки писем, но у меня возникла следующая проблема с моим кодом 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

Answer 1

Измените эти строки и попробуйте снова

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

Answer 2

Объект QueryDef не имеет свойства RecordCount ; 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

Вышеприведенное полностью не проверено, но, надеюсь, заставит вас двигаться в правильном направлении.