Referencing Query in VBA for Sending Multiple Emails

user_12281150 0
Viewed 103

I code for sending multiple email through Outlook using Access database.

I want to search query by criteria for emails and the use these filter emails for sending email but I have the following problem with my VBA code:

"method not found" for "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
ms-access vba
2 Answers

A QueryDef object does not have a RecordCount property; RecordCount is a property of a RecordSet or TableDef object.

As such, I would suggest modifying your code to something along the lines of the following:

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

The above is entirely untested, but should hopefully get you moving in the right direction.

user_75315980

Change these lines and try again

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
user_119207300
Related