wlwebb
asked on
Access - VB to auto email and text - Erroring
Hello Experts....
I have a VB code to automatically email and text the Manager information at the end of any shift. However, I'm getting an Error about Object no longer being set . Sometimes it happens in the Email Section of the code and sometimes it's in the Texting portion of the code. (don't know why sometimes it's one and sometimes it's the other...)
The first sending set starts at line 57
I suspect it hasn't sent the first one and is getting the second but that doesn't make sense why that would cause it to error.
Anyway the code I have is:
I have a VB code to automatically email and text the Manager information at the end of any shift. However, I'm getting an Error about Object no longer being set . Sometimes it happens in the Email Section of the code and sometimes it's in the Texting portion of the code. (don't know why sometimes it's one and sometimes it's the other...)
The first sending set starts at line 57
I suspect it hasn't sent the first one and is getting the second but that doesn't make sense why that would cause it to error.
Anyway the code I have is:
Private Sub SendMngrEmail()
Dim strSQL As String, strSQL2 As String, strSQL3 As String
Dim rs As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset
Dim a As String, b As String, c As String, d As String
Dim z As String, y1 As String, y2 As String, y3 As String, y4 As String, y5 As String
Dim q As String, r As String
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
On Error GoTo ProcError:
strSQL3 = "SELECT CompDBANameID, CompID, CompDBAEmailNotify, CompDBATextNotify FROM qry_CompDBANames"
Set rs3 = CurrentDb.OpenRecordset(strSQL3, dbOpenDynaset)
If rs3.RecordCount > 0 Then
rs3.MoveLast
rs3.MoveFirst
With rs3
If .RecordCount = 1 Then
q = !CompDBAEmailNotify
r = !CompDBATextNotify
Else
MsgBox "There are more than one possible DBA Company Names selected in the Code. Ask the system administrator to fix this issue.", vbOKOnly, "Multiple DBA selected"
q = !CompDBAEmailNotify & " FIX THE SELECT OF DBA NAME - MULTIPLES"
r = !CompDBATextNotify & " FIX THE SELECT OF DBA NAME - MULTIPLES"
End If
End With
End If
y1 = "AmtIn " & Format(Forms![frm_ShiftEndReportingNew]![sfrm_LVLInfo_DetailCtl].Form![sfrm_LVLInfo_ShiftEndNew].Form![sfrm_LVLInfoDetails].Form![txtInputAmtIn], "Currency")
y2 = "AmtOut " & Format(Forms![frm_ShiftEndReportingNew]![sfrm_LVLInfo_DetailCtl].Form![sfrm_LVLInfo_ShiftEndNew].Form![sfrm_LVLInfoDetails].Form![txtInputAmtOut], "Currency")
y3 = "NetAmt " & Format(Forms![frm_ShiftEndReportingNew]![sfrm_LVLInfo_DetailCtl].Form![sfrm_LVLInfo_ShiftEndNew].Form![sfrm_LVLInfoDetails].Form![txtInputNetAmt], "Currency")
y4 = "AmtVal " & Format(Forms![frm_ShiftEndReportingNew]![sfrm_LVLInfo_DetailCtl].Form![sfrm_LVLInfo_ShiftEndNew].Form![sfrm_LVLInfoDetails].Form![txtInputAmtVal], "Currency")
y5 = "Cash " & Format(Nz(GetcurShiftEndCash, 0), "Currency")
strbody = y1 & vbNewLine & y2 & vbNewLine & y3 & vbNewLine & y4 & vbNewLine & y5
' ******* Setup Email and Text Info to send
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = "2"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.xyzabc.net"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "joejoe@xyzmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "abc123xyz"
.Update
End With
' **** Send Shift End Emails
' ***** Set Email Addresses to receive notice
strSQL = "SELECT ShiftEndEmailNotifyID, ShiftEndEmailNotifyInactive, NotifyEmail, NickName, CompName " & _
"FROM qry_ShiftEndEmailNotify " & _
"WHERE ShiftEndEmailNotifyInactive=" & False
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
' ***** END Set Email Addresses to receive notice
If rs.RecordCount > 0 Then
Do Until rs.EOF
With rs
a = joejoe@xyzmail.com" From
b = rs!NotifyEmail 'To
c = "Shift End - " & z & " - " & rs!CompName ' Subject
d = strbody ' Message
With iMsg
Set .Configuration = iConf
.To = b
' .CC = ""
' .BCC = ""
.From = "joejoe@xyzmail.com"
.Subject = q
.TextBody = strbody
.Send
End With
.MoveNext
End With
Loop
End If
' **** END Shift End Emails
' ***** Set Text Addresses to receive notice
strSQL2 = "SELECT ShiftEndTextNotifyID, ShiftEndTextNotifyInactive, NotifyTextAddr, NickName, CompName " & _
"FROM qry_ShiftEndTextNotify " & _
"WHERE ShiftEndTextNotifyInactive=" & False
Set rs2 = CurrentDb.OpenRecordset(strSQL2, dbOpenDynaset)
' ***** END Set Text Addresses to receive notice
' **** Send Shift End Text Messages
If rs2.RecordCount > 0 Then
Do Until rs2.EOF
With rs2
a ="joejoe@xyzmail.com" 'From
b = rs2!NotifyTextAddr 'To
c = "Shift End - " & z & " - " & rs2!CompName ' Subject
d = strbody ' Message
With iMsg
Set .Configuration = iConf
.To = b
' .CC = ""
' .BCC = ""
.From = a
.Subject = r '"New figures"
.TextBody = strbody 'strbody
.Send
End With
.MoveNext
End With
Loop
End If
' **** END Shift End Text Messages
rs.Close
Set rs = Nothing
rs2.Close
Set rs2 = Nothing
rs3.Close
Set rs3 = Nothing
ProcError:
MsgBox "Error in Email Send"
Exit Sub
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I copied all of the "Send Shift End Emails section .... I get the following error on the .Send line...
Run-time error '-2147220958 (80040222)
The pickup directory path is required and was not specified.
Run-time error '-2147220958 (80040222)
The pickup directory path is required and was not specified.
Private Sub cmdTestMngrEmail_Click()
Dim strSQL1 As String, strSQL2 As String, strSQL3 As String
Dim strSQL4 As String
Dim rs1 As DAO.Recordset, rs2 As DAO.Recordset, rs3 As DAO.Recordset
Dim rs4 As DAO.Recordset
Dim a As String, b As String, c As String, d As String
Dim z As String, y1 As String, y2 As String, y3 As String, y4 As String, y5 As String
Dim q As String, r As String
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim Cmpy As Long
Dim strText As String
Dim strEmail As String
strText = "Test Café Text"
strEmail = "Test Café Email"
' ***** GET EMAIL & TEXTING Info ****
Cmpy = GetlngMyCompID()
strSQL4 = "SELECT CompEmailAddrID, CompID, CompEmailAddr, CompEmailInactive, SendFromEmailAcct, TextFromEmailAcct, SendFromEmailAcctNbr, TextFromEmailAcctNbr, SendFromEmailAcctPW, SendFromTextAcctPW FROM sCtl_CompEmailAddresses WHERE CompID=" & Cmpy
Set rs4 = CurrentDb.OpenRecordset(strSQL4, dbOpenDynaset)
If rs4.RecordCount > 0 Then
Else
MsgBox "The Company's Email and/or Texting defaults have not been defined." & vbNewLine & vbNewLine & "Please consult the System Administrator.", vbCritical + vbOKOnly, "Default Company Email & Text not defined!"
Exit Sub
End If
' ******* Setup Email and Text Info to send
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = "1"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.xyzmail.net"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "joejoe@xyz123mail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "testing123"
.Update
End With
' **** Send Shift End Emails
' ***** Set Email Addresses to receive notice
strSQL1 = "SELECT ShiftEndEmailNotifyID, ShiftEndEmailNotifyInactive, NotifyEmail, NickName, CompName " & _
"FROM qry_ShiftEndEmailNotify " & _
"WHERE ShiftEndEmailNotifyInactive=" & False
Set rs1 = CurrentDb.OpenRecordset(strSQL1, dbOpenDynaset)
' ***** END Set Email Addresses to receive notice
If rs1.RecordCount > 0 Then
Do Until rs1.EOF
With rs1
a = "joejoe@xyz123mail.com" ' From
b = rs1!NotifyEmail 'To
c = "Shift End - " & z & " - " & rs1!CompName ' Subject
d = strbody ' Message
With iMsg
Set .Configuration = iConf
.To = b
' .CC = ""
' .BCC = ""
.FROM = a
.Subject = q '"New figures"
.TextBody = strText 'strbody
.Send
End With
.MoveNext
End With
Loop
End If
' **** END Shift End Emails
' ***** Set Text Addresses to receive notice
strSQL2 = "SELECT ShiftEndTextNotifyID, ShiftEndTextNotifyInactive, NotifyTextAddr, NickName, CompName " & _
"FROM qry_ShiftEndTextNotify " & _
"WHERE ShiftEndTextNotifyInactive=" & False
Set rs2 = CurrentDb.OpenRecordset(strSQL2, dbOpenDynaset)
' ***** END Set Text Addresses to receive notice
' **** Send Shift End Text Messages
If rs2.RecordCount > 0 Then
Do Until rs2.EOF
With rs2
a = "joejoe@xyz123mail.com" ' From
b = rs2!NotifyTextAddr 'To
c = "Shift End - " & z & " - " & rs2!CompName ' Subject
d = strbody ' Message
With iMsg
Set .Configuration = iConf
.To = b
'.CC = ""
'.BCC = ""
.FROM = a
.Subject = r '"New figures"
.TextBody = strEmail 'strbody
.Send
End With
.MoveNext
End With
Loop
End If
' **** END Shift End Text Messages
End Sub
ASKER
OOPS.... I think the line 41 should be a "2"...
ASKER
Ok.... Now that I've got that found another problem with it...... Has to do with a variable
The text string that is being pulled from the DB has quotations in the Name (yes I need the quotations) so that it interprets the string coming in as
""xyz info""
Is there a way to allow the quotations to come in???????????
The text string that is being pulled from the DB has quotations in the Name (yes I need the quotations) so that it interprets the string coming in as
""xyz info""
Is there a way to allow the quotations to come in???????????
ASKER
Thanks Jeff.... I'll post a new question for the Variable issue
ok
ASKER