code not working

[ielamrani]

Hi,
this code is fine but it doesnot loop. It only send one email (the top one on the list of the table). How to fix it?
thanks in advance

Private Sub Command0_Click()

Dim db As Database
Dim rs As DAO.Recordset
'Dont't forget to reference the Outlook Object Library
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Email FROM Table1")


Do Until rs.EOF
On Error GoTo ErrorHandler

With objEmail
.To = rs!Email
.Subject = "Happy Holidays"
.HTMLBody = "Greetings from CD <br><br>"
.Attachments.Add "P:\Greetings.jpg", olByValue, , "Stuff"


.Send
End With
ErrorHandler:

Resume Next

rs.MoveNext

Loop


End Sub

[ADezii]

Hi,
this code is fine but it doesnot loop. It only send one email (the top one on the list of the table). How to fix it?
thanks in advance

Private Sub Command0_Click()

Dim db As Database
Dim rs As DAO.Recordset
'Dont't forget to reference the Outlook Object Library
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Email FROM Table1")


Do Until rs.EOF
On Error GoTo ErrorHandler

With objEmail
.To = rs!Email
.Subject = "Happy Holidays"
.HTMLBody = "Greetings from CD <br><br>"
.Attachments.Add "P:\Greetings.jpg", olByValue, , "Stuff"


.Send
End With
ErrorHandler:

Resume Next

rs.MoveNext

Loop


End Sub

Try this revised code and let me know how it works out:

Private Sub Command0_Click()
On Error GoTo ErrorHandler
 
Dim db As DAO.Database
Dim rs As DAO.Recordset
 
'Dont't forget to reference the Outlook Object Library
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
 
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
 
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Email FROM Table1")
 
Do Until rs.EOF
  With objEmail
    .To = rs!Email
    .Subject = "Happy Holidays"
    .HTMLBody = "Greetings from CD <br><br>"
    .Attachments.Add "P:\Greetings.jpg", olByValue, , "Stuff"
      .Send
  End With
    rs.MoveNext
Loop
 
Exit_Handler:
  Exit Sub
 
ErrorHandler:
  MsgBox Err.Description, vbExclamation, "Error in E-Mail Transmission"
  Resume Exit_Handler
End Sub

[ielamrani]

Perfect. Thank you so much and have a happy Holidays

[ielamrani]

Sorry, but it's still sending to one email only. also, I want to know if it's possible not to show the recipient's email address. I am sending this to 206 clients and we don't want to show everyone address.
thanks