Auto generate an email based on the drop down box selection...

[shoniaml]

Hi, I need to add a function to a database that is already built. When the information on the form in the access database is saved, an email is created and sent based on the code in place. What I need to Add is another email that is generated in the same fashion based on the entry in the drop down box. Im fairly new so bare with me.

[June7]

Can use SendObject method. Hard to advise without knowing more about your db structure, form behavior, and existing code.

What is the information in the combobox? How is it relevant to sending an email?

[shoniaml]

The email is sent based on saving the form.... I would like the email to be generated by the selection... The combo box lists what type of orders (Kitting, Emergency, Barcode, etc). Now all of the emails are generically the same, I would like if Kitting is selected, then the email go to "these people", if Sales Order is selected, then the email go to "those people". This is what we have... can it be done?

Option Compare Database

Private Sub btnSave_Click()

Dim strBodyText As String

Dim strRecipient As String

Dim strSubject As String

Dim objDiscrepancy As Object

'Dim EAddresses As Variant

Dim x As Integer

Dim objMessage As Object

Dim objConfig As Object

Dim objFields As Object

Dim intIndex As Integer

Dim rstTableName As DAO.Recordset 'Your table

Dim tblGateKeeper As DAO.Recordset

Set tblGateKeeper = CurrentDb.OpenRecordset("GateKeeper")

Dim EmailArray() As String 'Your dynamic array

Dim intArraySize As Integer 'The size of your array

Dim iCounter As Integer 'Index of the array

'Open your table

Set rstTableName = CurrentDb.OpenRecordset("Email_Addresses")

If Not rstTableName.EOF Then

rstTableName.MoveFirst 'Ensure we begin on the first row

'The size of the array should be equal to the number of rows in the table

intArraySize = rstTableName.RecordCount

iCounter = 0

ReDim EmailArray(intArraySize) 'Need to size the array

Do Until rstTableName.EOF

EmailArray(iCounter) = rstTableName.Fields("Email Address")

Debug.Print "Item: "; iCounter & " " & EmailArray(iCounter)

iCounter = iCounter + 2

rstTableName.MoveNext

Loop

End If

If IsObject(rstTableName) Then Set rstTableName = Nothing

For x = LBound(EmailArray) To UBound(EmailArray) - 1

strRecipient = EmailArray(x)

strSubject = "Discrepancy Alert"

strBodyText = "Discrepancy on ID Number: " & Forms!Discrepancy_Kiosk!ID.Value

Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.

Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 'Do not authenticate

Const cdoBasic = 1 'basic (clear-text) authentication

Const cdoNTLM = 2 'NTLM

'Delivery Status Notifications

Const cdoDSNDefault = 0 'None

Const cdoDSNNever = 1 'None

Const cdoDSNFailure = 2 'Failure

Const cdoDSNSuccess = 4 'Success

Const cdoDSNDelay = 8 'Delay

Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay

Set objMessage = CreateObject("CDO.Message")

Set objConfig = CreateObject("CDO.Configuration")

'==This section provides the configuration information for the remote SMTP server.

Set objFields = objConfig.Fields

With objFields

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

'Name or IP of Remote SMTP Server

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP-US.CORP.IRCO.COM" '*** ADD SMTP SERVER NAME HERE

'Type of authentication, NONE, Basic (Base64 encoded), NTLM

.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous

'Your UserID on the SMTP server

.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = tblGateKeeper.Fields("UserName") '*** ADD ACCOUNT NAME HERE

'Your password on the SMTP server

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = tblGateKeeper.Fields("Password") '*** ADD ACCOUNT PASSWORD HERE

'Server port (typically 25)

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

'Use SSL for the connection (False or True)

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)

.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

.Update

End With

With objMessage

Set .configuration = objConfig

.Subject = strSubject

.From = "jon.doe@yahoo.com"

.To = strRecipient

.TextBody = strBodyText

'If Not (colAttachmentPath Is Nothing) Then

'For intIndex = 1 To colAttachmentPath.Count

' .AddAttachment colAttachmentPath(intIndex)

' Next intIndex

'End If

.Send

End With

Set objMessage = Nothing

Set objConfig = Nothing

Set objFields = Nothing

Next x

Call MsgBox("Submission Successful!")

DoCmd.GoToRecord , , acNewRec

End Sub

[June7]

Options:

1. send one message to multiple addressees as TO: or CC: or BCC:

2. send multiple messages, each to a single addressee

In either case, this involves looping through a recordset filtered to the desired addressees (or have code that checks each record against criteria). Either to build a string of multiple addressees or to send message to single addressee in each record.

Which do you want?

You already have looping code that populates an array. I am not sure why you need array. Why not just build the string or send email within the loop?

BTW, post code between code tags and the structure will be retained for easier reading, assuming you use indentation in your code.

[shoniaml]

I would like to send one message to multiple adressees as TO:, My coworker had the code wrote. Help me understand what the array does and I can tell you if we need it or not.

[June7]

The code loops through recordset and populates array. Then it loops through the array and sends an email to each address. To me, the array is unnecessary. The email could be sent within the loop of the recordset.

However, if you want a single email with multiple addressees then the loop needs to construct a multi-address To string. Try:

Dim strBodyText As String
Dim strRecipient As String
Dim strSubject As String
Dim objDiscrepancy As Object
 
Dim objMessage As Object
Dim objConfig As Object
Dim objFields As Object
Dim intIndex As Integer
 
Dim rstTableName As DAO.Recordset 'Your table
Dim tblGateKeeper As DAO.Recordset
Set tblGateKeeper = CurrentDb.OpenRecordset("GateKeeper")
 
'Open your table
Set rstTableName = CurrentDb.OpenRecordset("Email_Addresses")
 
If Not rstTableName.EOF Then
    rstTableName.MoveFirst 'Ensure we begin on the first row
    Do Until rstTableName.EOF
        strRecipient = strRecipient & ";" & rstTableName![Email Address]
        rstTableName.MoveNext
    Loop
    'trim the extra ; from end of strRecipient
    strRecipient = Left(strRecipient, Len(strRecipient) - 1)

    Set rstTableName = Nothing

    strSubject = "Discrepancy Alert"
    strBodyText = "Discrepancy on ID Number: " & Forms!Discrepancy_Kiosk!ID.Value
    Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
    Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).
    Const cdoAnonymous = 0 'Do not authenticate
    Const cdoBasic = 1 'basic (clear-text) authentication
    Const cdoNTLM = 2 'NTLM
    'Delivery Status Notifications
    Const cdoDSNDefault = 0 'None
    Const cdoDSNNever = 1 'None
    Const cdoDSNFailure = 2 'Failure
    Const cdoDSNSuccess = 4 'Success
    Const cdoDSNDelay = 8 'Delay
    Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay
     
    Set objMessage = CreateObject("CDO.Message")
    Set objConfig = CreateObject("CDO.Configuration")
     
    '==This section provides the configuration information for the remote SMTP server.
    Set objFields = objConfig.Fields
    With objFields
        .Item("http://schemas.microsoft.com/cdo/con...tion/sendusing") = cdoSendUsingPort
        'Name or IP of Remote SMTP Server
        .Item("http://schemas.microsoft.com/cdo/con...ion/smtpserver") = "SMTP-US.CORP.IRCO.COM" '*** ADD SMTP SERVER NAME HERE
        'Type of authentication, NONE, Basic (Base64 encoded), NTLM
        .Item("http://schemas.microsoft.com/cdo/con...tpauthenticate") = cdoAnonymous
        'Your UserID on the SMTP server
        .Item("http://schemas.microsoft.com/cdo/con...n/sendusername") = tblGateKeeper.Fields("UserName") '*** ADD ACCOUNT NAME HERE
        'Your password on the SMTP server
        .Item("http://schemas.microsoft.com/cdo/con...n/sendpassword") = tblGateKeeper.Fields("Password") '*** ADD ACCOUNT PASSWORD HERE
        'Server port (typically 25)
        .Item("http://schemas.microsoft.com/cdo/con...smtpserverport") = 25
        'Use SSL for the connection (False or True)
        .Item("http://schemas.microsoft.com/cdo/con...ion/smtpusessl") = False
        'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
        .Item("http://schemas.microsoft.com/cdo/con...nectiontimeout") = 60
        .Update
    End With
     
    With objMessage
        Set .configuration = objConfig
        .Subject = strSubject
        .From = "jon.doe@yahoo.com"
        .To = strRecipient
        .TextBody = strBodyText
        'If Not (colAttachmentPath Is Nothing) Then
        'For intIndex = 1 To colAttachmentPath.Count
        ' .AddAttachment colAttachmentPath(intIndex)
        ' Next intIndex
        'End If
        .Send
    End With
     
    Set objMessage = Nothing
    Set objConfig = Nothing
    Set objFields = Nothing
     
    Call MsgBox("Submission Successful!")
End If

I don't know your data structure so I can only guess about how to use the combobox selection to limit the rstTableName recordset to just the addresses that fit the selected criteria. Maybe simply:
Set rstTableName = CurrentDb.OpenRecordset("SELECT * FROM Email_Addresses WHERE TypeOfOrder='" & Me.ComboboxName & "'")

Is the type of order field a text type?

[ItsMe]

I took the liberty of condensing the original code even more and incorporating June's loop with my condensed version. I also included a Bcc. This way you can email yourself using To and Bcc everyone else. I know I dislike it when I see mass emails with my address and 100 others in the To line. After you test the code you can uncomment the Bcc line and go live with it. You can visualize the Bcc line prioir by observing the Immediate Window.

'Dim strDirectory As String
Dim strBodyText As String
Dim strSubject As String
strBodyText = "Text for the body of the Email"
strSubject = "Subject Line"
Dim strEmailMe As String    'Send an email to yourself for confirmation
strEmailMe = "MyEmail@domain.com"
 
 
Dim rstTableName As DAO.Recordset 'Your table
Dim strRecipient As String
'Open your table
Set rstTableName = CurrentDb.OpenRecordset("Email_Addresses")
If Not rstTableName.EOF Then
    rstTableName.MoveFirst 'Ensure we begin on the first row
    Do Until rstTableName.EOF
        strRecipient = strRecipient & ";" & rstTableName![Email Address]
        rstTableName.MoveNext
    Loop
    'trim the extra ; from end of strRecipient
    strRecipient = Left(strRecipient, Len(strRecipient) - 1)
    Set rstTableName = Nothing
'Let's check the immediate window and
'make sure our string looks good
Debug.Print strRecipient
Dim objMessage As Object
Dim objConfig As Object
Set objMessage = CreateObject("CDO.Message")
Set objConfig = CreateObject("CDO.Configuration")
 
'==This section provides the configuration information for the remote SMTP server.
 
With objConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 'Name or IP of Remote SMTP Server
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP-US.CORP.IRCO.COM" '*** ADD SMTP SERVER NAME HERE
 'Type of authentication, NONE, Basic (Base64 encoded), NTLM
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0
 'Your UserID on the SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "UserName" '*** ADD ACCOUNT NAME HERE
 'Your password on the SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password" '*** ADD ACCOUNT PASSWORD HERE
 'Server port (typically 25)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 'Use SSL for the connection (False or True)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
 'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
 
.Update
End With
 
With objMessage
Set .configuration = objConfig
 
.Subject = strSubject
.From = strEmailMe
.To = strEmailMe
'.Bcc = strRecipient    'After we test, we can uncomment block
.TextBody = strBodyText
'.AddAttachment strDirectory
.Send
 
End With

[shoniaml]

Yes it is a text type. Ok, I am understanding it a little more. Right now, we enter names of whom the email needs to go to, on the email "table". We can add and remove and everyone that is entered there gets the same email alert. What I would like to do is have "certain" individuals get the email alert that pertains to their area, (entered in the combo box) and the others get the email that pertains to their area that was entered in they box. Right now, the email is just sent when the entry is saved.

[June7]

Sorry, do not understand the process as described.