# Sending test emails to a list of email addresses

I've made the following program that takes a list of email addresses from a table in MS Access and sends each a test email.

'Send email to mailing list
Function SendNotificationEmail()

'Handle any errrors
On Error GoTo ErrHandler:

'Create Outlook object
Dim olApp As Outlook.Application

'Namespace
Dim olNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder

'Create a reference to the email item you will use to send the email
Dim olMailItem As Outlook.MailItem

Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")

Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olMailItem = olFolder.Items.Add("IPM.Note")

'Create the body of the message
Dim strBodyText As String
strBodyText = "Test Email - DELETE ME :D"

'Open record set on
Dim dbC As DAO.Database
Dim rcdSet As DAO.Recordset
Dim fld As DAO.field

'Used to update the table
Dim strSQL As String
strSQL = "SELECT DISTINCT [Email Address] FROM tblMailingList"

'Connect to current database
Set dbC = CurrentDb
Set rcdSet = dbC.OpenRecordset(strSQL)

'Count the number of records
Dim intNumRecords As Integer
'Move to the last record in order to count all the records
rcdSet.MoveLast

intNumRecords = rcdSet.RecordCount - 1
'Move back
rcdSet.MoveFirst

'Get data back from field birth date
Set fld = rcdSet.Fields("Email Address")

'Subject
olMailItem.Subject = "Mailing List Test"

'Loop through the records
For i = 0 To intNumRecords
'Recipient/s
olMailItem.To = fld.Value

'Body of email
olMailItem.Body = strBodyText

'Automatically send the email
olMailItem.Send

'Reset email item otherwise it won't work
Set olMailItem = olFolder.Items.Add("IPM.Note")

'Move to the next record
rcdSet.MoveNext
Next

'Close record set and connection
rcdSet.Close

'Empty variables
Set fld = Nothing
Set rcdSet = Nothing
Set dbC = Nothing

'Relase all the object variables
Set olMailItem = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing

ErrHandler:

'If error occurs
If Err.Number <> 0 Then
MsgBox "Error Number: " + Err.Number + ": Description: " + Err.Description
End If

End Function


Is my approach above correct? I had to reset the olMailItem in the loop otherwise it would return a Type Error. Is there a better approach to sending multiple emails?

## 2 Answers

Set olMailItem = Nothing
Set olFolder = Nothing
Set olNS = Nothing
Set olApp = Nothing


is unnecessary. VBA is garbage collected, there's no need for this, or any of the other = Nothing's you have. Here's an article from one of the MS developers about this practice. It refers to VBScript, but VBA's garbage collection algorithm is similar, and probably substantially better than VBScript's.

Around

'Open record set on
Dim dbC As DAO.Database


You start a new level of indentation. Why? I thought when I first read this that it was a part of the loop below.

Finally, you might want to think more about your error handling (although VB's error handling isn't very fun to work with). For example, if you get an exception on olMailItem.Send, you might not care -- you want the script to keep going and try to send the next email, in case that was a fluke. However, if something goes wrong on Set rcdSet = dbC.OpenRecordset(strSQL), you probably want the script to quit entirely, since nothing afterwards is going to be useful if you don' have anything to work on.

Yes, I'd say your approach looks fine. If you want to see how someone else would do it, I've rewritten the code below. The differences are just style preferences, but sometimes it's nice to see how other people write the same code.

I put all my variables at the top. If your code is so long that you can't see your variables, you probably need to split into into two or more procedures. Next, I put constants for any values that won't change. I use all caps in constants so I can recognize them.

Depending on how many emails you send, the approach of saving them all, then sending later may or may not work. I've never benchmarked it, but it seems faster to send all at once.

Sub SendNotificationEmail()

Dim olApp As Outlook.Application
Dim olNs As Outlook.NameSpace
Dim olMailItem As Outlook.MailItem
Dim rsEmails As DAO.Recordset

Const sBODY As String = "Test Email - Delete Me"
Const sSUBJ As String = "Mailing List Test"
Const sSQL As String = "SELECT DISTINCT [EmailAddress] FROM tblMailingList;"

Set olApp = Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set rsEmails = CurrentDb.OpenRecordset(sSQL)

'Create them, but don't send yet
Do Until rsEmails.EOF
Set olMailItem = olApp.CreateItem(0)
With olMailItem
.To = rsEmails.Fields("EmailAddress").Value
.Subject = sSUBJ
.Body = sBODY
.Save
End With
rsEmails.MoveNext
Loop

'Send all the emails
For Each olMailItem In olNs.GetDefaultFolder(olFolderDrafts).Items
olMailItem.Send
Next olMailItem

End Sub