Email More Than One Address (1 Viewer)

Lochwood · Oct 18, 2017

Hi,

I trying to write code that emails all email addresses in a table. at the moment the code only emails the first address and never moves to the next record. what am i doing wrong? The table is Called DC_Appointees_Test and the field is Appointee_Email. Here is the code:

Private Sub Command1_Click()

Dim olApp As Object
Dim objMail As Object

On Error Resume Next 'Keep going if there is an error
Set olApp = GetObject(, "Outlook.Application") 'See if Outlook is open

If Err Then 'Outlook is not open
Set olApp = CreateObject("Outlook.Application") 'Create a new instance
End If
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)

With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.To = DLookup("[Appointee_Email]", "dc_appointees_test")
.Subject = "TEST "
.HTMLBody = "TEST "
.send
'.Display
.MoveNext
.Loop
End With

MsgBox "Close Box"

End Sub

Minty · Oct 18, 2017

You can't move next with a dlookup. Your process needs to be (pseudo code)

Code:

Open a recordset with all your email addresses
Move to the first record.
While Not rs.EOF
   Send your email
   MoveNext
 Loop

There are dozens of examples on here - search for loop to send emails.

arnelgp · Oct 18, 2017

same as Minty's code, but e-mail 10 person at a time:

Code:

Private Sub Command1_Click()
Dim olApp As Object
Dim objMail As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err Then Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(olMailItem)
WITH objMail
	.BodyFormat=olFormatHTML
	.Subject = "TEST"
	.HTMLBody = "TEST"

	Dim i As Integer
	Dim strRecipients As Variant
	Dim rs As DAO.Recordset

	Set rs =DBEngine(0)(0).OpenRecordSet("dc_appointees_test", dbOpenSnapshot)
	IF NOT (rs.BOF AND rs.EOF) Then .MoveFirst
	While Not rs.EOF
		i = i + 1
		strRecepients = strRecepients & !Appointee_Email & ";"
		rs.MoveNext
		If i >= 10 Or .EOF Then
			.To = strRecepients
			.Send
			'.Display
			i = 0
		End if
	Wend
	rs.Close
	Set rs=Nothing
End With
Msgbox "Close Box"

End Sub

Lochwood · Oct 18, 2017

Thanks for that. Cant get the code to populate addresses. i have changed the table to a query which shows the right results "email_query" and field "email_address" and enabled the display. outlook launches but no email addresses are populated. i only have 2 addresses in the query. here is the code.

Private Sub Command1_Click()
Dim olApp As Object
Dim objMail As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err Then Set olApp = CreateObject("Outlook.Application")
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.BodyFormat = olFormatHTML
.Subject = "TEST"
.HTMLBody = "TEST"

Dim i As Integer
Dim strRecepients As Variant
Dim rs As DAO.Recordset

Set rs = DBEngine(0)(0).OpenRecordset("email_query", dbOpenSnapshot)
If Not (rs.BOF And rs.EOF) Then .MoveFirst
While Not rs.EOF
i = i + 1
strRecepients = strRecepients & !Email_Address & ";"
rs.MoveNext
If i >= 10 Or .EOF Then
.To = strRecepients
.Send
.Display
i = 0
End If
Wend
rs.Close
Set rs = Nothing
End With
MsgBox "Close Box"
End Sub

Gasman · Oct 18, 2017

rs!Email_Address ?

Also use Option Explicit to avoid this error.

Minty · Oct 18, 2017

The code is missing a couple of recordset qualifiers I think. See the red code.

Code:

Private Sub Command1_Click()
    Dim olApp            As Object
    Dim objMail          As Object
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err Then Set olApp = CreateObject("Outlook.Application")
    Set objMail = olApp.CreateItem(olMailItem)
    With objMail
        .BodyFormat = olFormatHTML
        .Subject = "TEST"
        .HTMLBody = "TEST"

        Dim i            As Integer
        Dim strRecepients As Variant
        Dim rs           As DAO.Recordset

        Set rs = DBEngine(0)(0).OpenRecordset("email_query", dbOpenSnapshot)
        If Not (rs.BOF And rs.EOF) Then [COLOR="red"]rs[/COLOR].MoveFirst
        While Not rs.EOF
            i = i + 1
            strRecepients = strRecepients & [COLOR="Red"]rs[/COLOR]!Email_Address & ";"
            rs.MoveNext
            If i >= 10 Or [COLOR="red"]rs[/COLOR].EOF Then
                .To = strRecepients
                .Send
                .Display
                i = 0
            End If
        Wend
        rs.Close
        Set rs = Nothing
    End With
    MsgBox "Close Box"
End Sub

Lochwood · Oct 18, 2017

Minty said:

The code is missing a couple of recordset qualifiers I think. See the red code.

Code:

Private Sub Command1_Click()
    Dim olApp            As Object
    Dim objMail          As Object
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err Then Set olApp = CreateObject("Outlook.Application")
    Set objMail = olApp.CreateItem(olMailItem)
    With objMail
        .BodyFormat = olFormatHTML
        .Subject = "TEST"
        .HTMLBody = "TEST"

        Dim i            As Integer
        Dim strRecepients As Variant
        Dim rs           As DAO.Recordset

        Set rs = DBEngine(0)(0).OpenRecordset("email_query", dbOpenSnapshot)
        If Not (rs.BOF And rs.EOF) Then [COLOR="red"]rs[/COLOR].MoveFirst
        While Not rs.EOF
            i = i + 1
            strRecepients = strRecepients & [COLOR="Red"]rs[/COLOR]!Email_Address & ";"
            rs.MoveNext
            If i >= 10 Or [COLOR="red"]rs[/COLOR].EOF Then
                .To = strRecepients
                .Send
                .Display
                i = 0
            End If
        Wend
        rs.Close
        Set rs = Nothing
    End With
    MsgBox "Close Box"
End Sub

Works a Treat, Thanks Minty and Others.

Email More Than One Address (1 Viewer)

Lochwood

Registered User.

Minty

AWF VIP

arnelgp

..forever waiting... waiting for jellybean!

Lochwood

Registered User.

Gasman

Enthusiastic Amateur

Minty

AWF VIP

Lochwood

Registered User.

Similar threads

Users who are viewing this thread