Mega Code Archive

 

Categories / VisualBasic Script / Outlook

 

Send email for all records in an Access table

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