Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need to send MASS EMAILS!!!!

Status
Not open for further replies.

Cricker

Technical User
Sep 11, 2002
31
CA
I have this dbase set up using Access 97. There is info for LOTS of people. I have a subform also set up on the mainform. I need to do a search for a specific item on the subform and be able to get EVERYONE'S EMAIL also. Got that done (through a Query). Now I need to get all those Email addresses put into OUTLOOK to send off an Email. So basically I want a button (or anything else.. suggestions accepted) to be pushed and take all the Emails and directly go and place all the adresses in the CC: (this is the one where u can't c everyone's email). Can this be done???? I'm stuck between a ROCK and it's getting to drive me CRAZY!!!

Thanks for the help in advance....

cw
 
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...
 
Just a note:

You will want to use BCC (Blind Carbon Copy)
If you use just CC then the people will be able to see who else recieved the email.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top