|
Sub ControlOutlook()
Dim objOutlook As New Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strLtrContent As String
Dim rsContacts As New ADODB.Recordset
rsContacts.ActiveConnection = CurrentProject.Connection
rsContacts.Open "tblContacts"
Do While Not rsContacts.EOF
strLtrContent = "Dear " & rsContacts("FirstName") & " "
strLtrContent = strLtrContent & rsContacts("LastName") & ":"
Set objEmail = objOutlook.CreateItem(olMailItem)
objEmail.Recipients.Add rsContacts("Email")
objEmail.Subject = "Our address has changed."
objEmail.Body = strLtrContent
objEmail.Send
rsContacts.MoveNext
Loop
End Sub
|