Mass Emails

[cocoonfx]

hello i have a a form inwhich the user can send an email to all suppliers. The list of suppliers is some 150. The code i uses works but it will only do the first 10 email addresses. I have had a little play to see if i can make it send the lot with no luck. Does anyone know how to make the following code work so that i can send to everyone within the databas?

On Error GoTo error_Handler
Dim intRecordCount As Integer, i As Integer
Dim strToField As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strRptName As String
Dim strSQL As String
Me.Requery
strSQL = _
"SELECT tblEMail.[E-mail], tblEMail.SendTo" & _
" FROM tblEMail" & _
" WHERE (((tblEMail.SendTo)=Yes));"

Debug.Print strSQL
'Open the e-mail
rs.Open strSQL, CurrentProject.Connection, adOpenDynamic, adLockOptimistic

rs.MoveLast
rs.MoveFirst
'intRecordCount = rs.RecordCount

rs.MoveFirst
Do Until rs.EOF
If InStr(rs![e-mail], "@") < 1 Then
Else
If Len(strToField) = 0 Then
strToField = rs![e-mail]
cnt = 1
Else
strToField = strToField & ";" & rs![e-mail]
cnt = cnt + 1
End If
End If

rs.MoveNext
Loop
'Deselect 'runs deselect sub which switches all

DoCmd.SendObject , , , strToField, , , , , True
Exit Sub
error_Handler:
Dim Ask As Integer
Select Case Err
Case 2501
If MsgBox("You have chosen to cancel this E-Mail" & vbCr & "Is this correct", vbYesNo + vbQuestion, "Cancel E-Mail") = vbYes Then
Exit Sub
Else
Resume
End If
Case 3021
MsgBox "You have not selected any names to e-mail to"
End Select
'MsgBox Err

End Sub