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
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