Function Email(strTo As String, strSubject _
        As String, Optional varMsg As Variant, Optional varAttachment As Variant)

' ŠArvin Meyer 1999-2004 
' Permission to use is granted if copyright notice is left intact.
' Permisssion is denied for use with unsolicited commercial email

'Set reference to Outlook
On Error GoTo Errhandler
Dim strBCC As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim objOutl As Outlook.Application
'Dim objEml As Outlook.MailItem
Dim i As Integer

Set db = CurrentDb
Set rst = db.OpenRecordset("qryContacts", dbOpenSnapshot)

Set objOutl = CreateObject("Outlook.application")
'Set objEml = objOutl.createItem(olMailitem)

With rst
    If .RecordCount > 0 Then
        .MoveLast
        .MoveFirst
    End If
End With

For i = 1 To rst.RecordCount
    If Len(rst!EmailAddress) > 0 Then
        strTo = rst!EmailAddress
    Dim objEml As Outlook.MailItem
    Set objEml = objOutl.createItem(olMailitem)

        With objEml
            .To = strTo

            .Subject = strSubject
            
            If Not IsNull(varMsg) Then
                .Body = varMsg
            End If

' Uncomment for attachment            
'            If Not IsMissing(varAttachment) Then
'                .Attachments.Add varAttachment
'            End If
            
            .Send
        End With
    End If
    Set objEml = Nothing
    rst.MoveNext
Next i

ExitHere:
Set objOutl = Nothing
'Set objEml = Nothing
Set rst = Nothing
Set db = Nothing

    Exit Function
    
Errhandler:
    MsgBox Err.Number & ": " & Err.Description
    Resume ExitHere

End Function