Sending test emails to a list of email addresses

Question

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?

Answer 1

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.

Answer 2

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