Access Bulk Mail Visual Basic Recordset

[Antonio Macias]

Hi to all

I am trying maybe in the worse way to send emails in bulk in visual basic
from Access 2002 trough outlook 2002, whit a Recordset

This is my code:

Sub sendEmailBuck()

Dim dbs As Database, rstFirst1 As DAO.Recordset
Dim strSQL1 As String
Dim MyRecordsTotal As String
Dim strRecipient As String
Dim strSubject As String
Dim strBody As String
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecipt As Outlook.Recipient

MystrBody = "Hello Friends!"

On Error GoTo ErrorHandling

Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
Set dbs = CurrentDb()

'Cuenta el numero de registros en la tba <<Buy Out>>
MyRecordsTotal = DCount("*", "RegistrosNoDuplicados")
'MsgBox "Mis Registros son " & MyRecordsTotal

strSQL1 = ("select * from [RegistrosNoDuplicados] ORDER BY
[RegistrosNoDuplicados].ID;")
'Asigno a la variable «dbs» la base de datos activa.
Set dbs = CurrentDb
Set rstFirst1 = dbs.OpenRecordset(strSQL1, dbOpenSnapshot)
'Set rst2 = dbs.OpenRecordset(strSQL, dbReadOnly)

Do While Not rstFirst1.EOF

'Obtengo el ItemId
MyMail = rstFirst1.Fields("Correo Electronico")

With objOutlookMsg

'Subject = "eBay Item Purchase: " & MyeBayItemTitle & " (Item #" &
MyeBayItemId & ")"
.Subject = "Come to my Party"
.Body = MystrBody
.To = MyMail
.Send

End With

rstFirst1.MoveNext

Loop

rstFirst1.Close

Set objOutlookMsg = Nothing
Set objOutlook = Nothing

Exit Sub


ErrorHandling:

MsgBox Err & ": " & Err.Description


End Sub

But I got an error : -1906048758: Se movió o eliminó el elemento (The
element moved or deleted)
After the code sends the first mail

Some can help me?

Thanks in advance

Antonio Macias
Mexico City