send email with outlook using access query

Question

I found this code (I took a little out that isn't needed):

     Dim dbs As DAO.Database

     Dim rst As DAO.Recordset

     Dim strTo As String

     'Dim strSubject As String

     'Dim strMessage As String

     Set dbs = CurrentDb

     Set rst = dbs.OpenRecordset("PC Gaming", dbOpenForwardOnly)

     Do While Not rst.EOF

         strTo = rst.Fields("E-Mail Address")

         DoCmd.SendObject To:=strTo, _

             Subject:=strSubject, _

             MessageText:=strMessage, _

             EditMessage:=True ' False to send, True to view/edit

         rst.MoveNext

     Loop

     rst.Close

     Set rst = Nothing

     Set dbs = Nothing

I put this in to a module in access, but when I execute it, I'm only getting one email address in the to line when I have two in the database that meet the query criteria.

What I'm trying to do, is design a bit of code that will be able to execute a query, and then populate the e-mail addresses obtained from that query in to the BCC line in outlook, and then be able to type out an email.

Thanks in advance for your help!

Answer 1

I gave you 99% of what you needed. Here is the last percent. Your macro should not run the query, but rather run RunCode, with testEmail as the argument. Note that this MUST be a public function in a standard module.

Public Function testEmail()

    Dim dbs             As DAO.Database

    Dim rst             As DAO.Recordset

    Dim strTo           As String

    Set dbs = CurrentDb

    Set rst = dbs.OpenRecordset("myQuery", dbOpenSnapshot)

    If rst.RecordCount > 0 Then

        rst.MoveLast

        rst.MoveFirst

    End If

    Debug.Print "testEmail: query returns " & rst.RecordCount & " records."

    Do While Not rst.EOF

        strTo = strTo & rst.Fields("E-Mail Address") & ";"

        rst.MoveNext

    Loop

    DoCmd.SendObject BCC:=strTo, _

                     Subject:="my Subject", _

                     MessageText:="my Message", _

                     EditMessage:=True    ' False to send, True to view/edit

    rst.Close

    Set rst = Nothing

    Set dbs = Nothing

End Function

Answer 2

Hmm, what did you take out?  Looks like you missed this part...

    If rst.RecordCount > 0 Then

        rst.MoveLast

        rst.MoveFirst

    End If

You could also adjust the code above to include your query, something like...

Set rst = CurrentDb.OpenRecordset("SELECT * FROM qryYourQueryWitheMailAddresses")

...from http://www.access-diva.com/vba16.html

Not sure I understand why you would need a macro to run the query just run/open it from the code.

Answer 3

Ah, I understand what you mean. So, I can create one of these for each query essentially and just use the macro to run them.

Thanks so much for your help!

Answer 4

Well, I have a query already in access, and I want the code to access it. Not have a query in the VB code... so basically I have a query, and I have a macro. The macro runs the query, and then I need it to take those results and put them in to the BBC line in outlook.

It looks like the code that you have suggested would have the query in the code.

Answer 5

Public Sub testEmail()

    Const mySQL         As String = "select * from Customers where [E-mail Address] is not null"

    Dim dbs             As DAO.Database

    Dim rst             As DAO.Recordset

    Dim strTo           As String

    Set dbs = CurrentDb

    Set rst = dbs.OpenRecordset(mySQL, dbOpenSnapshot)

    If rst.RecordCount > 0 Then

        rst.MoveLast

        rst.MoveFirst

    End If

    Debug.Print "testEmail: query returns " & rst.RecordCount & " records."

    Do While Not rst.EOF

        strTo = strTo & rst.Fields("E-Mail Address") & ";"

        rst.MoveNext

    Loop

    DoCmd.SendObject BCC:=strTo, _

                     Subject:="my Subject", _

                     MessageText:="my Message", _

                     EditMessage:=True    ' False to send, True to view/edit

    rst.Close

    Set rst = Nothing

    Set dbs = Nothing

End Sub