Can't SendObject twice

  • Thread starter Thread starter Rick
  • Start date Start date
R

Rick

I use "DoCmd.SendObject acSendNoObject, , , strName, , ,
strSubject, txtmsg, True" to send an e-mail message, as
shown below. If I need to immediatly send another
message, it does not work. It will go through all the
code to create everything and give me my message box after
the Send but it doesn't do the Send. I have to close my
database and Access and reopen before it will send
again.

Anybody every have this situation?

Rick

Here the code I'm using.
Private Sub cmdSendEMail_Click()
'On Error GoTo email_err

'This sends messages to Client VIP but Parent contact is
in Outlook so make sure they jive

Set db = CurrentDb
sende = "Y"
'GoTo skipall

ans = MsgBox("Send E-mail?", vbYesNoCancel + vbQuestion +
vbDefaultButton1, "Send Msg")
Select Case ans
Case vbYes
sende = "Y"
Case vbCancel
sende = "C"
Case vbNo
sende = "N"
End Select

If sende = "C" Then Exit Sub

If IsNull(Me!cboClient) Then
MsgBox "Must Select Client"
Exit Sub
Else
strClientID = Me!cboClient
End If

strClient = DLookup("[CName]", "[tlkpClient]", "ClientID
= '" & strClientID & "'")
strNickName = DLookup
("[NickName]", "[tlkpClient]", "ClientID = '" &
strClientID & "'")
strFName = DLookup
("[VIP1FName]", "[tlkpClient]", "ClientID = '" &
strClientID & "'")
strLName = DLookup
("[VIP1LName]", "[tlkpClient]", "ClientID = '" &
strClientID & "'")

strName = strFName & " " & strLName

'MsgBox strClient
'Exit Sub

MsgNum = Me!OptMsgNum
oldven = Nz(Me!VendorID, "NIL")
If oldven <> "NIL" Then oldNam = DLookup
("VName", "tlkpVendor", "VendorID ='" & oldven & "'")

MsgTypNo = Me!OptMsgType
Select Case MsgTypNo
Case 1
MsgType = "NChng"
Case 2
MsgType = "NoWC"
Case 3
MsgType = "NotApp"
Case 4
MsgType = "Waive"
Case 5
MsgType = "ReqWaiveFax"
Case 6
MsgType = "ReqWaiveNFax"
Case 7
MsgType = "ReqWaiveXS"
XSCaried = Me!EntUmb
Case 8
MsgType = "ReqWaiveSplit"
XSCaried = Me!EntUmb
Case 9
MsgType = "Unknown"
oldNam = Me!txtNewVend
End Select


part3hold = "N"
If MsgType = "NChng" Then
Select Case MsgNum
Case 1, 3, 5, 6
newnam = Me!txtNewVend
If strClientID = "val001" Then part3hold = "Y"
Case Else
If IsNull(Me!VendorID) Then
MsgBox "Must Select Old and New Vendors
from Select Vendors."
Exit Sub
End If

strSQL = "SELECT tVenList.SelVen,
tVenList.VendorID "
strSQL = strSQL & "FROM tVenList "
strSQL = strSQL & "WHERE (((tVenList.SelVen)=-
1));"
Set rs_selven = db.OpenRecordset(strSQL)
rs_selven.MoveLast
If rs_selven.RecordCount = 1 Then
MsgBox "Must Select Old and New
Vendors from Select Vendors."
Exit Sub
End If
rs_selven.MoveFirst


Do Until rs_selven!VendorID <> oldven
rs_selven.MoveNext
Loop

NewVen = rs_selven!VendorID
newnam = DLookup
("VName", "tlkpVendor", "VendorID='" & NewVen & "'")

End Select
Else
If MsgType <> "Unknown" Then
strSQL = "SELECT tVenList.SelVen,
tVenList.VendorID "
strSQL = strSQL & "FROM tVenList "
strSQL = strSQL & "WHERE (((tVenList.SelVen)=-1));"
Set rs_selven = db.OpenRecordset(strSQL)
rs_selven.MoveLast
If rs_selven.RecordCount > 1 Then
MsgBox "Only Select One Vendor."
Exit Sub
End If
End If
End If

Call GetMsgs 'go to code to get the message to use based
on selections on the form

strCrit = "MsgType='" & MsgType & "' and MsgNum = " &
MsgNum
'MsgBox strCrit
rs_msg.FindFirst (strCrit)


part3 = IIf(part3hold = "N", Nz(rs_msg!part3), Nz(rs_msg!
Part3AddandHold))

txtmsg = strFName & "," & vbNewLine & vbNewLine

If Me!RcdOnly = -1 Then
txtmsg = txtmsg & "(You have already approved this;
This e-mail is for records only.)" & vbNewLine & vbNewLine
End If

txtmsg = txtmsg & rs_msg!part1 & " " & oldNam & " for " &
strNickName & IIf(MsgTypNo = 9, ". ", " ") & rs_msg!part2
& " " & newnam & " " & part3

Select Case MsgTypNo
Case 1 To 3
txtmsg = txtmsg & vbNewLine & "If you have any
reason for me not to do this please let me know."
txtmsg = txtmsg & vbNewLine & "Please let all your
people know of this change."
Case 4
txtmsg = txtmsg & vbNewLine & "If you have any
reason for me NOT to do this please let me know."
Case 5, 6
txtmsg = txtmsg & vbNewLine
strSQL = "SELECT tdatlkpCoverages.Coverage,
tdatlkpCoverages.selCvg "
strSQL = strSQL & "from tdatlkpCoverages "
strSQL = strSQL & "WHERE
(((tdatlkpCoverages.selCvg)=-1));"
Set rs_Cvgs = db.OpenRecordset(strSQL)
Do Until rs_Cvgs.EOF
txtmsg = txtmsg & vbNewLine & rs_Cvgs!Coverage
rs_Cvgs.MoveNext
Loop
txtmsg = txtmsg & vbNewLine & vbNewLine
& "Please e-mail me back with your decision."
Case 7, 8
txtmsg = txtmsg & vbNewLine
txtmsg = txtmsg & vbNewLine & FormatCurrency
(XSCaried, 2, vbFalse)
txtmsg = txtmsg & vbNewLine & vbNewLine & "Please
e-mail me back with your approval."
'Case 9
' txtmsg = txtmsg & vbNewLine
End Select

txtmsg = txtmsg & vbNewLine & "Thanks."
txtmsg = txtmsg & vbNewLine & vbNewLine & "Rick Carson"
txtmsg = txtmsg & vbNewLine & "Director of Operations"
txtmsg = txtmsg & vbNewLine & "CertCon Services"
txtmsg = txtmsg & vbNewLine & "817-810-0870 (phone)"
txtmsg = txtmsg & vbNewLine & "817-810-0869 (fax)"

strSubject = rs_msg!Subject & "-" & oldNam & " & " &
strNickName

skipall:
'If sende = "Y" Then
'strName = "Rick Carson"
'strSubject = "test5"
'txtmsg = "test35"
'msgBox strName
'MsgBox strSubject
'MsgBox txtmsg
DoCmd.SendObject acSendNoObject, , , strName, , ,
strSubject, txtmsg, True
'End If

Set rs_Msgs = db.OpenRecordset("tzhistEMessages")

rs_Msgs.AddNew
rs_Msgs!ClientID = strClientID
rs_Msgs!OldVendorID = oldven
rs_Msgs!OldVName = oldNam
rs_Msgs!NewVendorID = Nz(NewVen)
rs_Msgs!NewVName = newnam
rs_Msgs!MsgType = MsgType
rs_Msgs!MsgNum = MsgNum
If Not IsNull(XSCaried) Then
If MsgNum = 7 Then
rs_Msgs!Notes = "XS - " & XSCaried
ElseIf MsgNum = 8 Then
rs_Msgs!Notes = "GL - " & XSCaried
End If
End If
rs_Msgs.Update
rs_Msgs.Close

MsgBox "Recorded in tzhistEMessages. Be sure to delete or
de-activate, as required." & vbNewLine & "If there's hard
copy of corespondence-add transaction."

email_exit:
Exit Sub

email_err:
If Err.Number = 2501 Then
MsgBox "Send was canceled"
GoTo email_exit:
Else
MsgBox Err.Description
GoTo email_exit:
End If

End Sub
 
This is a known issue. See the following MS Knowledgebase article:
http://support.microsoft.com/default.aspx?scid=KB;en-us;q260819

--
--Roger Carlson
www.rogersaccesslibrary.com
Reply to: Roger dot Carlson at Spectrum-Health dot Org

Rick said:
I use "DoCmd.SendObject acSendNoObject, , , strName, , ,
strSubject, txtmsg, True" to send an e-mail message, as
shown below. If I need to immediatly send another
message, it does not work. It will go through all the
code to create everything and give me my message box after
the Send but it doesn't do the Send. I have to close my
database and Access and reopen before it will send
again.

Anybody every have this situation?

Rick

Here the code I'm using.
Private Sub cmdSendEMail_Click()
'On Error GoTo email_err

'This sends messages to Client VIP but Parent contact is
in Outlook so make sure they jive

Set db = CurrentDb
sende = "Y"
'GoTo skipall

ans = MsgBox("Send E-mail?", vbYesNoCancel + vbQuestion +
vbDefaultButton1, "Send Msg")
Select Case ans
Case vbYes
sende = "Y"
Case vbCancel
sende = "C"
Case vbNo
sende = "N"
End Select

If sende = "C" Then Exit Sub

If IsNull(Me!cboClient) Then
MsgBox "Must Select Client"
Exit Sub
Else
strClientID = Me!cboClient
End If

strClient = DLookup("[CName]", "[tlkpClient]", "ClientID
= '" & strClientID & "'")
strNickName = DLookup
("[NickName]", "[tlkpClient]", "ClientID = '" &
strClientID & "'")
strFName = DLookup
("[VIP1FName]", "[tlkpClient]", "ClientID = '" &
strClientID & "'")
strLName = DLookup
("[VIP1LName]", "[tlkpClient]", "ClientID = '" &
strClientID & "'")

strName = strFName & " " & strLName

'MsgBox strClient
'Exit Sub

MsgNum = Me!OptMsgNum
oldven = Nz(Me!VendorID, "NIL")
If oldven <> "NIL" Then oldNam = DLookup
("VName", "tlkpVendor", "VendorID ='" & oldven & "'")

MsgTypNo = Me!OptMsgType
Select Case MsgTypNo
Case 1
MsgType = "NChng"
Case 2
MsgType = "NoWC"
Case 3
MsgType = "NotApp"
Case 4
MsgType = "Waive"
Case 5
MsgType = "ReqWaiveFax"
Case 6
MsgType = "ReqWaiveNFax"
Case 7
MsgType = "ReqWaiveXS"
XSCaried = Me!EntUmb
Case 8
MsgType = "ReqWaiveSplit"
XSCaried = Me!EntUmb
Case 9
MsgType = "Unknown"
oldNam = Me!txtNewVend
End Select


part3hold = "N"
If MsgType = "NChng" Then
Select Case MsgNum
Case 1, 3, 5, 6
newnam = Me!txtNewVend
If strClientID = "val001" Then part3hold = "Y"
Case Else
If IsNull(Me!VendorID) Then
MsgBox "Must Select Old and New Vendors
from Select Vendors."
Exit Sub
End If

strSQL = "SELECT tVenList.SelVen,
tVenList.VendorID "
strSQL = strSQL & "FROM tVenList "
strSQL = strSQL & "WHERE (((tVenList.SelVen)=-
1));"
Set rs_selven = db.OpenRecordset(strSQL)
rs_selven.MoveLast
If rs_selven.RecordCount = 1 Then
MsgBox "Must Select Old and New
Vendors from Select Vendors."
Exit Sub
End If
rs_selven.MoveFirst


Do Until rs_selven!VendorID <> oldven
rs_selven.MoveNext
Loop

NewVen = rs_selven!VendorID
newnam = DLookup
("VName", "tlkpVendor", "VendorID='" & NewVen & "'")

End Select
Else
If MsgType <> "Unknown" Then
strSQL = "SELECT tVenList.SelVen,
tVenList.VendorID "
strSQL = strSQL & "FROM tVenList "
strSQL = strSQL & "WHERE (((tVenList.SelVen)=-1));"
Set rs_selven = db.OpenRecordset(strSQL)
rs_selven.MoveLast
If rs_selven.RecordCount > 1 Then
MsgBox "Only Select One Vendor."
Exit Sub
End If
End If
End If

Call GetMsgs 'go to code to get the message to use based
on selections on the form

strCrit = "MsgType='" & MsgType & "' and MsgNum = " &
MsgNum
'MsgBox strCrit
rs_msg.FindFirst (strCrit)


part3 = IIf(part3hold = "N", Nz(rs_msg!part3), Nz(rs_msg!
Part3AddandHold))

txtmsg = strFName & "," & vbNewLine & vbNewLine

If Me!RcdOnly = -1 Then
txtmsg = txtmsg & "(You have already approved this;
This e-mail is for records only.)" & vbNewLine & vbNewLine
End If

txtmsg = txtmsg & rs_msg!part1 & " " & oldNam & " for " &
strNickName & IIf(MsgTypNo = 9, ". ", " ") & rs_msg!part2
& " " & newnam & " " & part3

Select Case MsgTypNo
Case 1 To 3
txtmsg = txtmsg & vbNewLine & "If you have any
reason for me not to do this please let me know."
txtmsg = txtmsg & vbNewLine & "Please let all your
people know of this change."
Case 4
txtmsg = txtmsg & vbNewLine & "If you have any
reason for me NOT to do this please let me know."
Case 5, 6
txtmsg = txtmsg & vbNewLine
strSQL = "SELECT tdatlkpCoverages.Coverage,
tdatlkpCoverages.selCvg "
strSQL = strSQL & "from tdatlkpCoverages "
strSQL = strSQL & "WHERE
(((tdatlkpCoverages.selCvg)=-1));"
Set rs_Cvgs = db.OpenRecordset(strSQL)
Do Until rs_Cvgs.EOF
txtmsg = txtmsg & vbNewLine & rs_Cvgs!Coverage
rs_Cvgs.MoveNext
Loop
txtmsg = txtmsg & vbNewLine & vbNewLine
& "Please e-mail me back with your decision."
Case 7, 8
txtmsg = txtmsg & vbNewLine
txtmsg = txtmsg & vbNewLine & FormatCurrency
(XSCaried, 2, vbFalse)
txtmsg = txtmsg & vbNewLine & vbNewLine & "Please
e-mail me back with your approval."
'Case 9
' txtmsg = txtmsg & vbNewLine
End Select

txtmsg = txtmsg & vbNewLine & "Thanks."
txtmsg = txtmsg & vbNewLine & vbNewLine & "Rick Carson"
txtmsg = txtmsg & vbNewLine & "Director of Operations"
txtmsg = txtmsg & vbNewLine & "CertCon Services"
txtmsg = txtmsg & vbNewLine & "817-810-0870 (phone)"
txtmsg = txtmsg & vbNewLine & "817-810-0869 (fax)"

strSubject = rs_msg!Subject & "-" & oldNam & " & " &
strNickName

skipall:
'If sende = "Y" Then
'strName = "Rick Carson"
'strSubject = "test5"
'txtmsg = "test35"
'msgBox strName
'MsgBox strSubject
'MsgBox txtmsg
DoCmd.SendObject acSendNoObject, , , strName, , ,
strSubject, txtmsg, True
'End If

Set rs_Msgs = db.OpenRecordset("tzhistEMessages")

rs_Msgs.AddNew
rs_Msgs!ClientID = strClientID
rs_Msgs!OldVendorID = oldven
rs_Msgs!OldVName = oldNam
rs_Msgs!NewVendorID = Nz(NewVen)
rs_Msgs!NewVName = newnam
rs_Msgs!MsgType = MsgType
rs_Msgs!MsgNum = MsgNum
If Not IsNull(XSCaried) Then
If MsgNum = 7 Then
rs_Msgs!Notes = "XS - " & XSCaried
ElseIf MsgNum = 8 Then
rs_Msgs!Notes = "GL - " & XSCaried
End If
End If
rs_Msgs.Update
rs_Msgs.Close

MsgBox "Recorded in tzhistEMessages. Be sure to delete or
de-activate, as required." & vbNewLine & "If there's hard
copy of corespondence-add transaction."

email_exit:
Exit Sub

email_err:
If Err.Number = 2501 Then
MsgBox "Send was canceled"
GoTo email_exit:
Else
MsgBox Err.Description
GoTo email_exit:
End If

End Sub
Click to expand...
 
Back
Top