Solved: Email contacts from table - sample database

[bdsii]

Hello all....I am using Access 2007 and Outlook 2007 and I need to be able to email multiple contacts that are listed in one of my tables when the status of a case is changed and the Process Changes button is clicked.

The list of contacts to email changes based on the case status that is selected. Also, there is a Help button that should email a specific email address if that is clicked and which email address is used is based on a different field in the table than the Process Changes code.

The table with user names and email addresses would be updated periodically to add or remove members to this table so the list to email in each situation is not static. The emails will not be in a distribution list but only come from inside the Contacts table.

I have searched the internet and have not found an answer that helps me with this. I believe it is necessary to loop through a recordset and compile a list of recipients from the table to use as the To: field but I am not sure how that is done.

For the Process Changes button click, I have provided VBA code (assisted previously by geekgirlau) that does work to email the data from the form inside the text of the email. I just need help with the .To line for
recipients. The email addresses would come from tblContacts and ContactEmail field and are Text type.

For status changes to Pending, those contacts with ContactEmail = "looneytunes" would be added to the .To line.

For status changes to Closed, those contacts with ContactEmail = "scooby" would be added to the .To line.

For the Email Mars Help button, I have provided VBA code to email a request for help but also need the email addresses would come from tblContacts and ContactEmail field and are Text type. In this case,
those contacts with ContactUserType = "animated alien" would be added to the .To line.

I have created a sample database with three tables and a form to demonstrate what I need. I have added phony/funny sample data and hope that once this is answered by the experts here, it could be used to help other newbies who have to be asking this same question. A full database with VB code and resolution would be very helpful in teaching us how to accomplish this.

Anyone willing to help provide instruction and code for this ?

Thanks in advance for your help :hi:

[OBP]

Do you want the Recipients Hidden from each other?
In which case you would use the BCC for the address list.
I would suggest a query for each type of Change to list the names & email Addresses for the VBA to loop through.

I have this code working on another database

Set rs = CurrentDb.OpenRecordset("forman only 7 day")
If rs.RecordCount = 0 Then GoTo secondemail
rs.MoveLast
rs.MoveFirst
recount = rs.RecordCount
For count = 1 To recount
If Not IsNull(rs![EmailAddress]) Then EmailAddress = EmailAddress & rs![EmailAddress] & ";"
rs.MoveNext
Next count
EmailAddress = Left(EmailAddress, Len(EmailAddress) - 1)

Which loops through the query recordset & adds the recipients to a String Variable called "EmailAddress".

[OBP]

You can of course you a loop until EOF if you want instead of the for next loop, I am an old fashoined programmer and like to be able to check the number of records returned.

[bdsii]

Thanks OBP! I tweaked the code to work in this sample database and it works great! Even though I have it working, I am still a little fuzzy on declaring the recordsets and then closing them and setting them to Nothing. I am including my code below. Did I need to create a db and rs for each situation that would be used (Pending, Closed and then the HelpDesk) ? I put these right after the Option statement, was that correct ?

Option Compare Database
Public dbPending As DAO.Database
Public rsPending As DAO.Recordset
Public dbClosed As DAO.Database
Public rsClosed As DAO.Recordset
Public dbHelpDesk As DAO.Database
Public rsHelpDesk As DAO.Recordset


The Code below is in the Click event and seems to work fine. I didn't know what your "secondemail" sub contained so I just used a messagebox telling the user there were no email addresses. I suppose the correct way in the sample database would be to open the email with the To line blank.


Private Sub btnProcess_Click()


If Me.CaseResolution = "Pending" Then
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxx
' Email contents of form if the status has been changed to Pending

Dim objApp As Object
Dim objMsg As Object
Dim strMsg As String

Dim CountPending As Long
Dim recountPending As Long
Dim EmailAddressPending As String
Set dbPending = CurrentDb()
Set rsPending = CurrentDb.OpenRecordset("qryPendingEmails", dbOpenDynaset)
If rsPending.RecordCount = 0 Then MsgBox "No Emails Addresses Found"
rsPending.MoveLast
rsPending.MoveFirst
recountPending = rsPending.RecordCount
For CountPending = 1 To recountPending
If Not IsNull(rsPending![ContactEmail]) Then EmailAddressPending = EmailAddressPending & rsPending![ContactEmail] & ";"
rsPending.MoveNext
Next CountPending
EmailAddressPending = Left(EmailAddressPending, Len(EmailAddressPending) - 1)


strMsg = "Case ID " & Me.CaseInfoID & " has been changed to Pending Status" & Chr(13) & _
"The submission information follows: " & Chr(13) & _
"=========================================================================== ==============" & Chr(13) & Chr(13) & _
"Case Description: " & Me.CaseDescription & Chr(13) & _
"Case Start Date: " & Me.CaseStartDate & Chr(13) & _
"Case Resolution: " & Me.CaseResolution & Chr(13) & _
"Case Contact: " & Me.ContactFirst & " " & Me.ContactLast & Chr(13) & _
"Please review this information and contact the sender with questions" & Chr(13)
Set objApp = CreateObject("Outlook.Application")
Set objMsg = objApp.CreateItem(0)

With objMsg
.To = EmailAddressPending
.Subject = "Change to Pending Status of Case"
.Body = strMsg
.Display
'.Send
End With

Set objMsg = Nothing
Set objApp = Nothing

rsPending.Close
Set dbPending = Nothing
Set rsPending = Nothing




' end email
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxx

Else
' Do Nothing
End If
'

If Me.CaseResolution = "Closed" Then
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxx
' Email contents of form if the status has been changed to Pending

Me.CaseResolutionDate.Value = Date


Dim objApp2 As Object
Dim objMsg2 As Object
Dim strMsg2 As String


Dim CountClosed As Long
Dim recountClosed As Long
Dim EmailAddressClosed As String
Set dbClosed = CurrentDb()
Set rsClosed = CurrentDb.OpenRecordset("qryClosedEmails", dbOpenDynaset)
If rsClosed.RecordCount = 0 Then MsgBox "No Emails Addresses Found"
rsClosed.MoveLast
rsClosed.MoveFirst
recountClosed = rsClosed.RecordCount
For CountClosed = 1 To recountClosed
If Not IsNull(rsClosed![ContactEmail]) Then EmailAddressClosed = EmailAddressClosed & rsClosed![ContactEmail] & ";"
rsClosed.MoveNext
Next CountClosed
EmailAddressClosed = Left(EmailAddressClosed, Len(EmailAddressClosed) - 1)



strMsg2 = "Case ID " & Me.CaseInfoID & " has been changed to Closed Status" & Chr(13) & _
"The submission information follows: " & Chr(13) & _
"=========================================================================== ==============" & Chr(13) & Chr(13) & _
"Case Description: " & Me.CaseDescription & Chr(13) & _
"Case Start Date: " & Me.CaseStartDate & Chr(13) & _
"Case Resolution: " & Me.CaseResolution & Chr(13) & _
"Case Contact: " & Me.ContactFirst & " " & Me.ContactLast & Chr(13) & _
" Please review this information and contact the sender with questions" & Chr(13)
Set objApp2 = CreateObject("Outlook.Application")
Set objMsg2 = objApp2.CreateItem(0)

With objMsg2
.To = EmailAddressClosed
.Subject = "Change to Closed Status of Case"
.Body = strMsg2
.Display
'.Send
End With

Set objMsg2 = Nothing
Set objApp2 = Nothing

rsClosed.Close
Set dbClosed = Nothing
Set rsClosed = Nothing

' end email
' xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxxxx

Else
' Do Nothing
End If

DoCmd.RunMacro "mcrSave", , ""

End Sub



Also, what does the code below accomplish ? I cannot figure that part out.

EmailAddressPending = Left(EmailAddressPending, Len(EmailAddressPending) - 1)


Thanks so much for your help in this. I am hoping that this will also help others coming along have a complete example to use to help them. I suppose that this is pretty simple stuff and I am just a not understanding but I would think this is something many people could benefit from.

:-)

[bdsii]

the completed sample database is attached in case it helps anyone....

email addresses from table

sending email using email address in table

[OBP]

If it works it should be OK.
That line of code removes the ";" from th endof the email.

[bdsii]

I have run into another problem with this now. When I changed the queries generating the recordsets (qryPendingEmails and qryClosedEmails) by using [Forms].[frmCaseForm].[ContactGroup] as the Criteria for ContactGroup then I got an error Run-Time Error 3061 - Too few parameters. Expected 1 - for the following line of code:


Set rsPending = CurrentDb.OpenRecordset("qryPendingEmails", dbOpenDynaset)


It works when I type into the criteria what I am wanting but when I try to use a value from the form, I get this error.

Is my error in passing the value to the query or somewhere else ? I have looked all over for a solution and cannot seem to find one.

In my actual database, I am getting this error when it hits the above code, but when I manually check the query for each record of the form, the query shows the correct data. Help ????

Thanks !

[OBP]

Sorry, one thing a VBA Recordset can't handle is a Query with a Criteria that refers to a Form value.
You can overcome this by using an SQL VBA Recordset instead.

[bdsii]

Will have to check the web for creating a SQL VBA Recordset .....thanks for the info :-)

[OBP]

Assuming that the VBA is on the frmCaseForm then the code would be like this
Dim rs As Object, SQL As String


SQL = "SELECT qryPendingEmails.* " & _
"FROM qryPendingEmails " & _
"WHERE ContactGroup = " & Me.ContactGroup
Set rs = CurrentDb.OpenRecordset(SQL)