Hello,
I have been using this code for a few days now and it seems to work well except under one situation.
If I create a new product record and do not enter a Product Manager then I get the error shown in the image attached when I update the subform (and attempt to automatically send the e-mail saying "No PM")
The line the debugger stops at and highlights is: If Nz(rst![work e-mail], "") = "" Then
This only happens when a new product record is created and I try to update the subform for it right away. If the product record ever had a name for Product Manager, meaning there was one but at some point it was removed, then there is no error and I do get the correct "No PM" message.
The complete code is:
Option Compare Database
Private Sub Form_AfterUpdate()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strEmailAddress As String
Dim mail
Dim TestInput As Variant
Dim PMName As Variant
Dim ProjectName As Variant
Dim email As String
'find the comment that is getting updated to send it
Me.Comment.SetFocus
TestInput = Me.Comment.Text
'Find the PM whose project this is
[Forms]![Project Main]![Product Manager].SetFocus
PMName = [Forms]![Project Main]![Product Manager].Text
'MsgBox PMName ' This would show a box with the PM Name
'Find the Project Name this e-mail refers to
[Forms]![Project Main]![Project Name].SetFocus
ProjectName = [Forms]![Project Main]![Project Name].Text
'Find the e-mail address of that PM
strSQL = "SELECT [Work e-mail] FROM [Product Managers] WHERE Name='" & [Forms]![Project Main]![Product Manager] & "';"
' MsgBox strSQL ' This would show a box with the code to find the PM
' Open pointer to current database
Set dbs = CurrentDb()
' Create recordset based on SQL
Set rst = dbs.OpenRecordset(strSQL)
If Nz(rst![work e-mail], "") = "" Then
strEmailAddress = "miki@gmail.com"
TestInput = "No PM"
Else
strEmailAddress = rst![work e-mail]
End If
' If Not rst.EOF And Not rst.BOF Then
' 'Code Assumes only 1 match will be found.
' '.MoveFirst
' strEmailAddress = rst![work e-mail]
' Else
' strEmailAddress = "mfrontera@hobbico.com"
' End If
' MsgBox strEmailAddress 'This whould show the e-mail address the e-mail is being sent to
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
Set mail = Nothing
' Send by connecting to port 25 of the SMTP server.
Dim iMsg
Dim iConf
Dim Flds
Dim strHTML
Dim strEmailTo
Const cdoSendUsingPort = 2
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
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") = "10.1.10.63"
.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 & "<b> </b></br>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"
' Apply the settings to the message.
With iMsg
Set .Configuration = iConf
.To = strEmailAddress
.cc = "mfrontera@hobbico.com"
.From = "Airplane R&D Database" 'MailFrom 'this should be OK
.Subject = ProjectName
.HTMLBody = TestInput 'this should be OK
.Send 'this should be OK
End With
' Clean up variables.
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
'MsgBox "Mail Sent!"
End Sub
What is happening? Should I set a default value of "" for that field? Something else?
mafhobb
I have been using this code for a few days now and it seems to work well except under one situation.
If I create a new product record and do not enter a Product Manager then I get the error shown in the image attached when I update the subform (and attempt to automatically send the e-mail saying "No PM")
The line the debugger stops at and highlights is: If Nz(rst![work e-mail], "") = "" Then
This only happens when a new product record is created and I try to update the subform for it right away. If the product record ever had a name for Product Manager, meaning there was one but at some point it was removed, then there is no error and I do get the correct "No PM" message.
The complete code is:
Option Compare Database
Private Sub Form_AfterUpdate()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strEmailAddress As String
Dim mail
Dim TestInput As Variant
Dim PMName As Variant
Dim ProjectName As Variant
Dim email As String
'find the comment that is getting updated to send it
Me.Comment.SetFocus
TestInput = Me.Comment.Text
'Find the PM whose project this is
[Forms]![Project Main]![Product Manager].SetFocus
PMName = [Forms]![Project Main]![Product Manager].Text
'MsgBox PMName ' This would show a box with the PM Name
'Find the Project Name this e-mail refers to
[Forms]![Project Main]![Project Name].SetFocus
ProjectName = [Forms]![Project Main]![Project Name].Text
'Find the e-mail address of that PM
strSQL = "SELECT [Work e-mail] FROM [Product Managers] WHERE Name='" & [Forms]![Project Main]![Product Manager] & "';"
' MsgBox strSQL ' This would show a box with the code to find the PM
' Open pointer to current database
Set dbs = CurrentDb()
' Create recordset based on SQL
Set rst = dbs.OpenRecordset(strSQL)
If Nz(rst![work e-mail], "") = "" Then
strEmailAddress = "miki@gmail.com"
TestInput = "No PM"
Else
strEmailAddress = rst![work e-mail]
End If
' If Not rst.EOF And Not rst.BOF Then
' 'Code Assumes only 1 match will be found.
' '.MoveFirst
' strEmailAddress = rst![work e-mail]
' Else
' strEmailAddress = "mfrontera@hobbico.com"
' End If
' MsgBox strEmailAddress 'This whould show the e-mail address the e-mail is being sent to
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
Set mail = Nothing
' Send by connecting to port 25 of the SMTP server.
Dim iMsg
Dim iConf
Dim Flds
Dim strHTML
Dim strEmailTo
Const cdoSendUsingPort = 2
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
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") = "10.1.10.63"
.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 & "<b> </b></br>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & "</HTML>"
' Apply the settings to the message.
With iMsg
Set .Configuration = iConf
.To = strEmailAddress
.cc = "mfrontera@hobbico.com"
.From = "Airplane R&D Database" 'MailFrom 'this should be OK
.Subject = ProjectName
.HTMLBody = TestInput 'this should be OK
.Send 'this should be OK
End With
' Clean up variables.
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
'MsgBox "Mail Sent!"
End Sub
What is happening? Should I set a default value of "" for that field? Something else?
mafhobb
