Here is what I've done... I loop thru a listbox and send e-mails to selected people. htih
Private Sub cmd_EMail_Click()
Dim lcMessageText As String 'Message Content for MessageBox Information
Dim lcMessage As String 'Message Content for EMAIL
Dim lcEMail As String 'Email Address
Dim ldVALUE_Date As Date 'Value Date
Dim lcSubject As String 'Subject Line
Dim lcUserGroup As String 'User Group
Dim lcTNUM_List As String 'List of TNUMs used for E-Mail Log
Dim ldEMAIL_Time As Date 'EMail Date/Time
Dim lcQryStr As String 'Query String
Dim ThisDB As DAO.Database 'Database
Dim llTestCall As Boolean 'Test flag for function calls
Dim lnUserResponse As Integer 'Response to Message Box
Dim intJCnt As Integer 'Loop Control Variable
Dim lcNextEMail As String
Const conBtns As Integer = vbOKOnly + vbExclamation + vbDefaultButton1 + vbApplicationModal
Set ThisDB = CurrentDb
lcMessageText = ""
On Error GoTo Err_cmd_EMail_Click
'Error Checking Section
'----------------------
If Me.lst_Approve.ListCount = 0 Then
lcMessageText = lcMessageText & "No Primary Data Has Been Entered!" & vbCr
End If
If (Me.lst_Approve.ItemsSelected.Count = 0 And Me.chkAll.Value = 0) Then
lcMessageText = lcMessageText & "Select at least 1 Person or Select All. " & vbCr
End If
If lcMessageText = "" Then
' No Error Message - Proceed to Produce Report
Else
lnUserResponse = MsgBox(lcMessageText, conBtns, "Error Selecting EMail Recipients!"

Me.lst_Approve.SetFocus
Exit Sub
End If
'Loop Through List
'-----------------
lcEMail = ""
intJCnt = 1
lcMessage = Me.txt_Message.Value
lcSubject = Me.txt_Subject.Value
Do
If Me.lst_Approve.Selected(intJCnt) Or Me.chkAll = -1 Then
lcEMail = Me.lst_Approve.Column(1, intJCnt)
lcMessage = lcMessage & vbCr & vbCr & "Additional Information: " & vbCr
lcMessage = lcMessage & "WebSeries URL:
& vbCr
lcMessage = lcMessage & " Corp ID: " & Me.lst_Approve.Column(4, intJCnt) & vbCr
lcMessage = lcMessage & " User ID: " & Me.lst_Approve.Column(6, intJCnt) & vbCr
lcMessage = lcMessage & "Password: Contact IT Help Desk (x1234) if forgotten." & vbCr & vbCr & vbCr
lcMessage = lcMessage & "If you feel you should not be a WebSeries User, please contact John Doe, Treasury Group." & vbCr
lcMessage = lcMessage & "
llTestCall = SendEMailOut(lcEMail, lcSubject, lcMessage)
If llTestCall = True Then
'Write to EMAIL Log - Implement Later?
'lcQryStr = "INSERT INTO EMAIL_LOG (USER_GROUP, EMAIL_ADDRESS, EMAIL_DATE, TNUM_LIST) VALUES " & _
"('" & lcUserGroup & "', '" & lcEMail & "', '" & Now() & "', '" & lcTNUM_List & "')"
'ThisDB.Execute lcQryStr
lcEMail = ""
lcMessage = Me.txt_Message.Value
End If
End If
intJCnt = intJCnt + 1
Loop Until intJCnt = Me.lst_Approve.ListCount
lcMessageText = vbCr & "E-Mails Have Been Sent to Selected WebSeries Users." & vbCr & vbCr
lnUserResponse = MsgBox(lcMessageText, conBtns, "E-Mail to Select WebSeries Users Completed"
Exit_cmd_EMail_Click:
Exit Sub
Err_cmd_EMail_Click:
MsgBox Err.DESCRIPTION
Resume Exit_cmd_EMail_Click
End Sub
Public Function SendEMailOut(lcEM, lcSUBJ, lcMess)
On Error GoTo Err_SendEMailOut
DoCmd.SendObject acSendNoObject, "", acFormatTXT, lcEM, , , lcSUBJ, lcMess, False
SendEMailOut = True
Exit_SendEMailOut:
Exit Function
Err_SendEMailOut:
SendEMailOut = False
MsgBox Err.DESCRIPTION
Resume Exit_SendEMailOut
End Function Steve Medvid
"IT Consultant & Web Master"
e-Mail: Stephen_Medvid@GMACM.com
Chester County, PA Residents
Please Show Your Support...