B
Bob Vance
If I fail to send this email I dont want to have the error message
(SentObject) to show just accept it not sent...Thanks Bob
Private Sub SendMailButton_Click()
On Error GoTo ErrorHandler
If Me.Dirty = True Then
Me.Dirty = False
End If
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, sndReport As String, strCompany As String
'*****JK: Added 17/10/06
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp As
Integer
Dim strFormat As String
Select Case Me.tbEmailOption.value
Case "ADOBE"
strFormat = acFormatPDF
Case "WORD"
strFormat = acFormatRTF
Case "SNAPSHOT"
strFormat = acFormatSNP
Case "TEXT"
strFormat = acFormatTXT
Case "HTML"
strFormat = acFormatHTML
Case Else ' catch all others
strFormat = acFormatHTML
End Select
Select Case Me.OpenArgs
Case "OwnerStatement"
sndReport = "rptOwnerPaymentMethod"
lngID = Nz(Me.cbOwnerName.Column(0), 0)
strMail = OwnerEmailAddress(lngID)
strBodyMsg = "To: "
strBodyMsg = strBodyMsg & Nz(DLookup("[ClientTitle]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " ") & " "
strBodyMsg = strBodyMsg & Nz(DLookup("[OwnerLastName]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " Owner")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement, Dated" & " " &
Format(Date, "d-mmm-yyyy") & eMailSignature("Best Regards", True) & Chr(10)
& Chr(10) & DownloadMessage("PDF") _
CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
DoCmd.SendObject acSendReport, sndReport, strFormat, strMail,
Cc:=DLookup("EmailCC", "tblOwnerInfo", "OwnerID = " & lngID),
Bcc:=DLookup("EmailBCC", "tblOwnerInfo", "OwnerID = " & lngID), _
Subject:="Your Statement" & " / " & Nz(DLookup("[CompanyName]",
"tblCompanyInfo")), MessageText:=strBodyMsg 'EditMessage:=blEditMail
cbOwnerName.SetFocus
Case Else
Exit Sub
End Select
Exit Sub
ErrorHandler:
msgTitle = "Untrapped Error"
msgBtns = vbExclamation
If Err.Number = 2501 Then
Err.Clear
Exit Sub
End If
MsgBox "Error Number: " & Err.Number & Chr(13) _
& "Description: " & Err.Description & Chr(13) & Chr(13) _
& "(frmBillStatement SendMailButton_Click)", msgBtns, msgTitle
End Sub
(SentObject) to show just accept it not sent...Thanks Bob
Private Sub SendMailButton_Click()
On Error GoTo ErrorHandler
If Me.Dirty = True Then
Me.Dirty = False
End If
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, sndReport As String, strCompany As String
'*****JK: Added 17/10/06
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp As
Integer
Dim strFormat As String
Select Case Me.tbEmailOption.value
Case "ADOBE"
strFormat = acFormatPDF
Case "WORD"
strFormat = acFormatRTF
Case "SNAPSHOT"
strFormat = acFormatSNP
Case "TEXT"
strFormat = acFormatTXT
Case "HTML"
strFormat = acFormatHTML
Case Else ' catch all others
strFormat = acFormatHTML
End Select
Select Case Me.OpenArgs
Case "OwnerStatement"
sndReport = "rptOwnerPaymentMethod"
lngID = Nz(Me.cbOwnerName.Column(0), 0)
strMail = OwnerEmailAddress(lngID)
strBodyMsg = "To: "
strBodyMsg = strBodyMsg & Nz(DLookup("[ClientTitle]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " ") & " "
strBodyMsg = strBodyMsg & Nz(DLookup("[OwnerLastName]",
"tblOwnerInfo", _
"[OwnerID]=" & lngID), " Owner")
strBodyMsg = strBodyMsg & "," & Chr(10) & Chr(10) & Chr(13) _
& "Please find attached your Statement, Dated" & " " &
Format(Date, "d-mmm-yyyy") & eMailSignature("Best Regards", True) & Chr(10)
& Chr(10) & DownloadMessage("PDF") _
CurrentDb.Execute "UPDATE tblOwnerInfo " & _
"SET EmailDateState = Now() " & _
"WHERE OwnerID = " & lngID, dbFailOnError
DoCmd.SendObject acSendReport, sndReport, strFormat, strMail,
Cc:=DLookup("EmailCC", "tblOwnerInfo", "OwnerID = " & lngID),
Bcc:=DLookup("EmailBCC", "tblOwnerInfo", "OwnerID = " & lngID), _
Subject:="Your Statement" & " / " & Nz(DLookup("[CompanyName]",
"tblCompanyInfo")), MessageText:=strBodyMsg 'EditMessage:=blEditMail
cbOwnerName.SetFocus
Case Else
Exit Sub
End Select
Exit Sub
ErrorHandler:
msgTitle = "Untrapped Error"
msgBtns = vbExclamation
If Err.Number = 2501 Then
Err.Clear
Exit Sub
End If
MsgBox "Error Number: " & Err.Number & Chr(13) _
& "Description: " & Err.Description & Chr(13) & Chr(13) _
& "(frmBillStatement SendMailButton_Click)", msgBtns, msgTitle
End Sub