gold007eye
Registered User.
- Local time
- Yesterday, 19:25
- Joined
- May 11, 2005
- Messages
- 260
Here is my dilema; I have a handler for Error 3021, but my problem is that this can be the error for 3 different sections of code. What I need to accomplish is that if it fails w/ Error 3021 on the 1st part of the code to continue with the next part of code from the point in which the code triggered the error. (I have attached the complete code (see the red text to see what sections would cause this error.
Basically what the code is doing is looking at a table to see who to send the email via either To:, CC:, or BCC: based on what is checked in the table. Here is where the problem triggers the errror:
Example:
User 1: Under Group 1: should have the email CC: so the CC: box is checked, but the To: & BCC: boxes are left UNchecked.
When the code runs through and it sees that the To: field is Null it is triggering Error 3021.
What I need it to do is say:
To: is Null move to the next section of code and check to see if the CC: field is null; then check to see if the BCC: field is null.
Basically what the code is doing is looking at a table to see who to send the email via either To:, CC:, or BCC: based on what is checked in the table. Here is where the problem triggers the errror:
Example:
User 1: Under Group 1: should have the email CC: so the CC: box is checked, but the To: & BCC: boxes are left UNchecked.
When the code runs through and it sees that the To: field is Null it is triggering Error 3021.
What I need it to do is say:
To: is Null move to the next section of code and check to see if the CC: field is null; then check to see if the BCC: field is null.
Code:
Private Sub Email_Test_Click()
On Error GoTo Err_Save_Click
'---=== Send Mail Code - START ===---
Dim mail
Set mail = Nothing
' Send by connecting to port 25 of the SMTP server.
Dim iMsg
Dim iConf
Dim strTo As String, rsTo As DAO.Recordset
Dim strCC As String, rsCC As DAO.Recordset
Dim strBCC As String, rsBCC As DAO.Recordset
Dim Flds
Dim strHTML
Const cdoSendUsingPort = 2
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set rsTo = CurrentDb.OpenRecordset("Select [PERD Security Access].[Email Address], [Email List].To, [Email List].[AR Code Group] FROM [PERD Security Access] INNER JOIN [Email List] ON [PERD Security Access].[EDS Net ID] = [Email List].[EDS Net ID] WHERE [Email List].[To]=True AND [Email List].[AR Code Group]= '" & [AR Group] & "'")
Set rsCC = CurrentDb.OpenRecordset("Select [PERD Security Access].[Email Address], [Email List].CC, [Email List].[AR Code Group] FROM [PERD Security Access] INNER JOIN [Email List] ON [PERD Security Access].[EDS Net ID] = [Email List].[EDS Net ID] WHERE [Email List].[CC]=True AND [Email List].[AR Code Group]= '" & [AR Group] & "'")
Set rsBCC = CurrentDb.OpenRecordset("Select [PERD Security Access].[Email Address], [Email List].BCC, [Email List].[AR Code Group] FROM [PERD Security Access] INNER JOIN [Email List] ON [PERD Security Access].[EDS Net ID] = [Email List].[EDS Net ID] WHERE [Email List].[BCC]=True AND [Email List].[AR Code Group]= '" & [AR Group] & "'")
[COLOR="red"]'---=== Handle rs strings & recordsets - START ===---
'-== rsTo - START ==-
With rsTo
.MoveFirst
Do
strTo = strTo & ![Email Address] & ";"
.MoveNext
Loop Until .EOF
strTo = Left(strTo, Len(strTo) - 1)
.Close
End With
'-== rsTo - END ==-
'-== rsCC - START ==-
With rsCC
.MoveFirst
Do
strCC = strCC & ![Email Address] & ";"
.MoveNext
Loop Until .EOF
strCC = Left(strCC, Len(strCC) - 1)
.Close
End With
'-== rsCC - END ==-
'-== rsBCC - START ==-
With rsBCC
.MoveFirst
Do
strBCC = strBCC & ![Email Address] & ";"
.MoveNext
Loop Until .EOF
strBCC = Left(strBCC, Len(strBCC) - 1)
.Close
End With
'-== rsBCC - END ==-
'---=== Handle rs strings & recordsets - END ===---[/COLOR]
Set Flds = iConf.Fields
' Set the CDOSYS configuration fields to use port 25 on the SMTP server.
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
'ToDo: Enter name or IP address of remote SMTP server.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "usahm204.amer.corp.eds.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Update
End With
' Build HTML for message body.
strHTML = "<HTML>"
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "This is an automated e-mail to let you know that <b><font color=#FF0000>" & [Name of Requestor] & "</b></font> from <b><font color=#FF0000>" & [Department of Requestor] & "</b></font> has submitted a new <b><font color=#FF0000>A/R " & [A/R Code] & "</b></font> request in PERD."
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"
'==== A/R Code Group - 1 - START ====
'If [AR Group] = 1 Then
' Apply the settings to the message.
With iMsg
Set .Configuration = iConf
.To = strTo 'ToDo: Enter a valid email address. "<Diane.Nastasia@examhub.exch.eds.com>;<M.Derivois@examhub.exch.eds.com>"
.Cc = strCC '"<Deborah.Davis@examhub.exch.eds.com>"
.Bcc = strBCC '"<Jason.Boney@examhub.exch.eds.com>" '<Carlene.Vitello@examhub.exch.eds.com>,
.From = "PERD Request<Jason.Boney@eds.com>" 'ToDo: Enter a valid email address.
.Subject = "New A/R " & [A/R Code] & " Request - TEST"
.HTMLBody = strHTML
.Send
End With
'==== A/R Code Group - 1 - END ====
'End If
' Clean up variables.
Set iMsg = Nothing
Set iConf = Nothing
Set rsTo = Nothing
Set rsCC = Nothing
Set rsBCC = Nothing
Set Flds = Nothing
'---=== Send Mail Code - END ===---
MsgBox "Your request has been submitted!" & vbCrLf & vbCrLf & "Your request will be completed shortly" & vbCrLf & vbCrLf & "-Database Admin", vbInformation, "Request Submitted"
Exit_Save_Click:
Exit Sub
Err_Save_Click:
If Err = 3021 Then 'No Current Record
'Not sure how to handle this error to move to the next section of code?
Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Save_Click
End If
End Sub
