Automaticaly Send Batch E-mail from Outlook 1

[darall]

This post is related to archived thread702-396121.

I used the code provided in the thread above to automatically generate e-mail messages to employees when they have an overdue task. The code is tied to a command button on my form.

What I would like to do is have all of the e-mail messages generated for all records in the form when I click the command button instead of having to go to each record and click on the command button.

The number of records varies depending on the number of overdue records that day.

Here is my code:

=======================================================
Private Sub cmdPreviewEmail_Click()
Dim strEmail, strBody, strSubject, strFrom As String
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

'**creates an instance of Outlook
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

'*****************************************
'*create string with email address
strFrom = "GMB-EITSS-Work-Engagement"
strEmail = CCAddress
strSubject = SUBJECT

strBody = MainText

'***creates and previews email
With objEmail
.SentOnBehalfOfName = strFrom
.To = strEmail
.SUBJECT = strSubject
.Body = strBody
.Preview

End With
Set objEmail = Nothing
Exit Sub
End Sub
=======================================================

 

[PHV]

Have a look at the RecordsetClone, MoveFirst, EOF, Fields and MoveNext methods/properties of the Form/DAO.Recordset objects.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Zion7]

As PHV said, just, here's how you may format it;

Private Sub cmdPreviewEmail_Click()
On Error GoTo xxx
Dim strEmail, strBody, strSubject, strFrom As String
Dim objOutlook As Outlook.Application
Dim rec as DAO.Recordset
...

Do until rec.EOF
If chkOverdue = True then

'*create string with email address
strFrom = "GMB-EITSS-Work-Engagement"
strEmail = CCAddress
strSubject = SUBJECT

strBody = MainText

'***creates and previews email
With objEmail
.SentOnBehalfOfName = strFrom
.To = strEmail
.SUBJECT = strSubject
.Body = strBody
.Preview
End If
rec.moveNext
Loop

End With


CleanUp:
rec.Close: set rec = Nothing
Set objEmail = Nothing
Exit Sub

xxx:
MsgBox err.Number & vbcrlf & err.description
Resume cleanUp
End Sub

 

[darall]

Thank you Zion7 and PHV.

I have added the statement, however when I try to run it I get a Compile Error: User-defined type not defined. When I click OK the rec As DAO.Recordset line is highlighted.

 

[darall]

OK I figured that out: Tools-> References-> and select, Microsoft DAO 3.6 Object Library.

Now I have another error:
Compile error: End If without block If

I tried removing the if and got this error:
Compile error: Loop without Do

Here is the altered code I am using:

=======================================================
Private Sub cmdSendAll_Click()
On Error GoTo xxx
Dim strEmail, strBody, strSubject, strFrom As String
Dim objOutlook As Outlook.Application
Dim rec As DAO.Recordset


Do Until rec.EOF

'*create string with email address
strFrom = "GMB-EITSS-Work-Engagement"
strEmail = CCAddress
strSubject = SUBJECT

strBody = MainText

'***creates and previews email
With objEmail
.SentOnBehalfOfName = strFrom
.To = strEmail
.SUBJECT = strSubject
.Body = strBody
.Preview

rec.MoveNext
Loop

End With


CleanUp:
rec.Close: Set rec = Nothing
Set objEmail = Nothing
Exit Sub

xxx:
MsgBox Err.Number & vbCrLf & Err.Description
Resume CleanUp
End Sub
=======================================================

 

[Remou]

Your End With seems to have gone astray.

    With objEmail
         .SentOnBehalfOfName = strFrom
         .To = strEmail
         .SUBJECT = strSubject
         .Body = strBody
         .Preview
        End With

rec.MoveNext
Loop

'     End With

 

[RoyVidar]

By doing "proper" indentation, you would probably have found this yourself ;-)
[tt]
Private Sub cmdSendAll_Click()
On Error GoTo xxx
Dim strEmail, strBody, strSubject, strFrom As String
Dim objOutlook As Outlook.Application
Dim rec As DAO.Recordset

Do Until rec.EOF
'*create string with email address
strFrom = "GMB-EITSS-Work-Engagement"
strEmail = CCAddress
strSubject = SUBJECT
strBody = MainText
'***creates and previews email
With objEmail
.SentOnBehalfOfName = strFrom
.To = strEmail
.SUBJECT = strSubject
.Body = strBody
.Preview
end with
rec.MoveNext
Loop
' End With <- wrong place
CleanUp:
rec.Close: Set rec = Nothing
Set objEmail = Nothing
Exit Sub
xxx:
MsgBox Err.Number & vbCrLf & Err.Description
Resume CleanUp
End Sub[/tt]

I don't know how to explain it properly in english, but you can't start one block, then another, then close the first block (here: do while loop) before the second block (here: with block)

Roy-Vidar

 

[darall]

I think I understand...now I hope I am not being a pain, but I moved the end with and am now getting a different error:
91
Object variable or With block variable not set

When I click OK it just keeps giving me the same error. I pressed Ctrl+Break and choose Debug, the Resume CleanUp line is highlighted.


Thanks again for all the great help!

 

[Remou]

You have not set your recordset, as far as I can see.

Dim rec As DAO.Recordset
'This need to be changed to suit your table
Set rs = CurrentDB.OpenRecordset("SELECT * FROM tblTable WHERE SomeField='SomeValue'" 
Do Until rec.EOF

 

[Zion7]

As Remou said,

to add, Since you removed the If Statment. You can filter the records, in your Recordset clause.

Set rs = CurrentDB.OpenRecordset("SELECT * FROM tblTable WHERE chkOverdue = -1"

 

[Remou]

Sorry Zion7, I typed rs without thinking and have thrown you off. It should be rec in the above example:

Dim rec As DAO.Recordset
Set [red]rec[/red] = CurrentDB.OpenRecordset("SELECT * FROM tblTable WHERE

 

[Zion7]

Thanks Remou!

...serves me right, for plagiarizing (cut & paste), LOL!!!