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