I'm hoping someone can help me out with this code below. Trying to send emails from outlook 2010 using a specific email account (NOT the default) based on a static template that pulls data from a table (senders_table) for the (TO:, Subject, and a few variable fields within the email body). So far the code below works except that it is not cycling through all of the records in my table. Emails go out through the specified account and with the proper data pulled from the table in the email but stops after the first record.
Private Sub test_Click()
'You must add a reference to the Microsoft Outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Dim strmail As String
Dim strsubject As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Senders_Table")
With rs
If .EOF And .BOF Then
MsgBox "No mails will be sent becuase there are no records assigned from the list", vbInformation
Else
Do Until .EOF
stremail = ![mail]
strsubject = ![property]
strbody = "Dear " & ![name] & "," & _
Chr(10) & Chr(10) & "Some kind of greeting" & ![property] & "!" & _
" email message body goes here"
.Edit
.Update
.MoveNext 'THIS MOVES TO THE NEXT RECORD IN THE RECORDSET
Loop
End If
End With
On Error Resume Next
With OutMail
.To = stremail
.CC = ""
.BCC = ""
.Subject = strsubject
.Body = strbody
'Change Item(1)to another number to use another account
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
.Send 'or use .Display
End With
On Error GoTo 0
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Private Sub test_Click()
'You must add a reference to the Microsoft Outlook Library
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Dim strmail As String
Dim strsubject As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Senders_Table")
With rs
If .EOF And .BOF Then
MsgBox "No mails will be sent becuase there are no records assigned from the list", vbInformation
Else
Do Until .EOF
stremail = ![mail]
strsubject = ![property]
strbody = "Dear " & ![name] & "," & _
Chr(10) & Chr(10) & "Some kind of greeting" & ![property] & "!" & _
" email message body goes here"
.Edit
.Update
.MoveNext 'THIS MOVES TO THE NEXT RECORD IN THE RECORDSET
Loop
End If
End With
On Error Resume Next
With OutMail
.To = stremail
.CC = ""
.BCC = ""
.Subject = strsubject
.Body = strbody
'Change Item(1)to another number to use another account
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
.Send 'or use .Display
End With
On Error GoTo 0
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
Set OutMail = Nothing
Set OutApp = Nothing
End Sub