Email out batching loop issue (1 Viewer)

Hello all, been a regular visitor but never got around to signing up.
Ok, heres my issue, have written code to mail out, no probs, but to get around ips limitations I have decided to send them in batches. The loop is giving ne a headache, I know its obvious but am missing it, keep getting an eof error. The loop shows 164 email in database, groups them in lots of 20 but gives me an eof error with the remaining 4 records. Be damned if I get see what I have missed.

Test code as follows:

Public Function Test(myRS As String)
'?Test("qry_newsletter_email")
Dim DB As DAO.Database
Dim MailList As DAO.Recordset
Dim MyBCC As String
Dim myCount, totalEmails, myBatch As Integer
Dim myRemainder As Integer
Set DB = CurrentDb()
Set MailList = DB.OpenRecordset(myRS)
myBatch = 20
MyBCC = ""
myCount = 1
MailList.MoveLast
totalEmails = MailList.RecordCount
myRemainder = totalEmails Mod myBatch
Debug.Print "ttl:" & (totalEmails - myRemainder)
Debug.Print "rem:" & myRemainder
MailList.MoveFirst
Do Until MailList.EOF
For myCount = 1 To myBatch
MyBCC = MyBCC & MailList("Email") & "(" & myCount & ");"
MailList.MoveNext
Next
Debug.Print MyBCC
MyBCC = ""
Loop
MailList.Close
Set MailList = Nothing
DB.Close
Set DB = Nothing
End Function

Haven't followed it all the way through, but I suspect the problem is here:

For myCount = 1 To myBatch

For the last 4, since that loop is still going to 20, the MoveNext will cause an error after the recordset has reached EOF. I think you'll need to track how many are still left and code it so the last pass only runs for the remaining records. I would probably do it a little differently, using the Do loop and a counter. When the counter hits 20, send your email and reset the counter.

Yes, I know the "For myCount = 1 To myBatch" is the problem but damned if I can see the way round. You suggest a do loop to handle count but how would you handle the check for the remainder, less than the "myBatch = 20"?
All help is greatly appreciated.

I would try something like this untested pseudo code:

The If/Then block inside the loop will handle each group of 20, the block after the loop will handle the leftovers (4 in your example).

nice n simple, will give it a go and post the results if all ok. Typical I went for the overkill approach. Thanks

No problemo, and welcome to the site by the way! Post back with your results, as I'd like to know if my brain is operating properly or undergoing a mid-afternoon brain cramp.

Paul,
Worked a treat, only alteration was I had to set the primary variable to 1 instead of 0. Only have to change the Debug.Print MyBCC to point to my mail routine and all is great. Thank you.

amended code:
'?Test("qry_newsletter_email")
Dim DB As DAO.Database
Dim MailList As DAO.Recordset
Dim MyBCC As String
Dim myCount, totalEmails, myBatch As Integer
Dim myRemainder As Integer
Set DB = CurrentDb()
Set MailList = DB.OpenRecordset(myRS)
myBatch = 20
MyBCC = ""
myCount = 1
MailList.MoveLast
totalEmails = MailList.RecordCount
myRemainder = totalEmails Mod myBatch
Debug.Print "ttl:" & (totalEmails - myRemainder)
Debug.Print "rem:" & myRemainder
MailList.MoveFirst
Do While Not MailList.EOF
MyBCC = MyBCC & MailList("Email") & "(" & myCount & ");"
If myCount = myBatch Then
Debug.Print MyBCC
MyBCC = ""
myCount = 0
End If
myCount = myCount + 1
MailList.MoveNext
Loop
If MyBCC > "" Then
Debug.Print MyBCC
End If
MailList.Close
Set MailList = Nothing
DB.Close
Set DB = Nothing

Excellent! Glad it worked for you.

paul,
Loop went in and tested.... but sorry to be a hassle, during the test phase, I used .display instead of .send it pops up only 2 emails, one from the loop and one from the remainder. There is a total of 164 emails it the test db. Is this a normal occurance for display or am I missing something, not real keen to go for a send yet.
code as follows:
myBatch = 20
MyBCC = ""
myCount = 1
MailList.MoveFirst
Do Until MailList.EOF
MyBCC = MyBCC & MailList("Email") & ";"
If myCount = myBatch Then
'Debug.Print MyBCC
MyMail.BCC = MyBCC
'MyMail.Send
MyMail.Display
MyBCC = ""
myCount = 0
End If
myCount = myCount + 1
MailList.MoveNext
Loop
If MyBCC > "" Then
'Debug.Print MyBCC
MyMail.BCC = MyBCC
'MyMail.Send
MyMail.Display
End If

Can you post the db, or at least the rest of the code? I suspect you need to create a new "myMail" object each pass. I have a loop that displays multiple emails for the user to examine before sending. I have these lines inside the loop:

Set MyOutlook = CreateObject("Outlook.Application")
Set MyMail = MyOutlook.CreateItem(0)
...
MyMail.display

as follows

Dim DB As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim MyBCC, secAddress, secName As String
Dim myAttachment As Variant
Dim totalEmails, myGroup, myBatch, myCount As Integer
Subjectline$ = DLookup("email_header", "tbl_email", "emailID = 1")
If Subjectline$ = "" Then
Exit Function
End If

BodyFile$ = DLookup("email_body", "tbl_email", "emailID = 1")
If BodyFile$ = "" Then
Exit Function
End If
Set MyOutlook = New Outlook.Application
Set DB = CurrentDb()
Set MailList = DB.OpenRecordset(myRS)
MailList.MoveLast
totalEmails = MailList.RecordCount
Debug.Print "Total: " & totalEmails
myAttachment = DLookup("email_attachment", "tbl_email", "emailID = 1")
If Not IsNull(myAttachment) Then
MyMail.Attachments.Add myAttachment, olByValue, 1, "Gambier Coachlines Attachment"
End If
MyMail.To = "fred@hotmail.com"
secName = "Fred Bloggs" & vbNewLine & "Freds Business"
secAddress = "Freds Address" & vbNewLine & "Freds Town" & vbNewLine & " Freds State, Zip" & vbNewLine
secAddress = secAddress & "Web: www.fred.com" & vbNewLine & "Email: fred@hotmail.com"
MyMail.Subject = Subjectline$
MyMail.Body = BodyFile$ & vbNewLine & vbNewLine & secName & vbNewLine & secAddress
myBatch = 20
MyBCC = ""
myCount = 1
MailList.MoveFirst
Do Until MailList.EOF
MyBCC = MyBCC & MailList("Email") & ";"
If myCount = myBatch Then
'Debug.Print MyBCC
MyMail.BCC = MyBCC
'MyMail.Send
MyMail.Display
MyBCC = ""
myCount = 0
End If
myCount = myCount + 1
MailList.MoveNext
Loop
If MyBCC > "" Then
'Debug.Print MyBCC
MyMail.BCC = MyBCC
'MyMail.Send
MyMail.Display
End If
Set MyMail = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
DB.Close
Set DB = Nothing

please disregard above posts mess, have sorted it out. You were spot on with the object needing to be within each pass. Will post it as soon as its tidied up.

Thanks again

ok its working, bit rough but does the job. I am using ExpressClickYes to geet around the click to send from outlook issue.
Code as follows:

Public Function SendEMail(myRS As String)
'?SendEMail("qry_newsletter_email")
Dim DB As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim BodyFile, mySubject As String
Dim MyBCC, secAddress, secName As String
Dim myAttachment As Variant
Dim mailTo, attachmentName, myBody As String
Dim totalEmails, myBatch, myCount As Integer

Set DB = CurrentDb()
Set MailList = DB.OpenRecordset(myRS)

MailList.MoveLast
totalEmails = MailList.RecordCount

myBatch = 20
MyBCC = ""
myCount = 1

Set MyOutlook = New Outlook.Application

mailTo = fred@fred.com

attachmentName = "Freds Attachment"
myAttachment = DLookup("email_attachment", "tbl_email", "emailID = 1")

mySubject = DLookup("email_header", "tbl_email", "emailID = 1")
If mySubject = "" Then
Exit Function
End If

secName = "Freds Business"
secAddress = "Freds Address" & vbNewLine
secAddress = secAddress & "Web: www.fred.org" & vbNewLine & "Email: fred@fred.org"
BodyFile = DLookup("email_body", "tbl_email", "emailID = 1")
If BodyFile = "" Then
Exit Function
End If
myBody = BodyFile & vbNewLine & vbNewLine & secName & vbNewLine & secAddress

MailList.MoveFirst
Do Until MailList.EOF
MyBCC = MyBCC & MailList("Email") & ";"
If myCount = myBatch Then
Set MyMail = MyOutlook.CreateItem(olMailItem)
If Not IsNull(myAttachment) Then
MyMail.Attachments.Add myAttachment, olByValue, 1, attachmentName
End If
MyMail.To = mailTo
MyMail.Subject = mySubject
MyMail.Body = myBody
MyMail.BCC = MyBCC
'MyMail.Send
MyMail.Display
MyBCC = ""
myCount = 0
End If
myCount = myCount + 1
MailList.MoveNext
Loop

If MyBCC > "" Then
Set MyMail = MyOutlook.CreateItem(olMailItem)
If Not IsNull(myAttachment) Then
MyMail.Attachments.Add myAttachment, olByValue, 1, attachmentName
End If
MyMail.To = mailTo
MyMail.Subject = mySubject
MyMail.Body = myBody
MyMail.BCC = MyBCC
'MyMail.Send
MyMail.Display
End If

Set MyMail = Nothing
Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
DB.Close
Set DB = Nothing
End Function

Glad you got it working.