B
Bob Vance
My Db has 2 ways of sending a report via email
(1) OwnerStatement, which just creates the email, then you manually send it
(2) Invoice , which sends the report via email on deactivate, I am trying to
get Invoice to just create the email and then you can send it manually like
ownerStatement
Thanks in advance for any help with this......Bob
Both codes are listed below
--------------------------------------------------------
Private Sub SendMailButton_Click()
On Error GoTo ErrorHandler
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, sndReport As String, strCompany As String
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp As
Integer
Select Case Me.OpenArgs
Case "OwnerStatement"
sndReport = "rptOwnerPaymentMethod"
lngID = Nz(Me.cbOwnerName.Column(0), 0)
strMail = OwnerEmailAddress(lngID)
strBodyMsg = "Dear "
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) _
& "Attached is your Statement for the period from " &
Format(Me.tbDateFrom, "d-mmm-yy") _
& " to " & Format(Me.tbDateTo, "d-mmm-yy") & "." _
& eMailSignature("Best Regards", True) & Chr(10) & Chr(10) _
& DownloadMessage("rtf")
DoCmd.SendObject acSendReport, sndReport, acFormatRTF, strMail,
, , "Your Statement", _
strBodyMsg, True
Case Else
Exit Sub
End Select
Exit Sub
ErrorHandler:
msgTitle = "Untrapped Error"
msgBtns = vbExclamation
If Err.Number = 2501 Then 'Prevent error when send is canceled
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
---------------------------------------------------------------------------------
Private Sub Report_Deactivate()
On Error GoTo Error_Handler
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, dtInvDate As Date, varInvNum As Variant, _
idHorse As Long, strHorse As String
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp
As Integer
If CurrentProject.AllForms("frmModify").IsLoaded = True Then
lngID = DLookup("OwnerID", "tblInvoice", "InvoiceID = " _
& Form_frmModify.lstModify.Column(0))
ElseIf CurrentProject.AllForms("frmModifyInvoiceClient").IsLoaded = True
Then
lngID = DLookup("OwnerID", "tblInvoice", "InvoiceID = " _
& Form_frmModifyInvoiceClient.lstModify.value)
Else
Exit Sub
End If
strMail = Nz(DLookup("Email", "tblOwnerInfo", "OwnerID = " & lngID), "")
If Not IsEmailOn Or Not IsOwnerWithEmail(lngID) Then
Exit Sub
End If
dtInvDate = Me.tbInvoiceDate
varInvNum = Me.tbInvoiceNumber
idHorse = Nz(Me.tbHorseID, 0)
If idHorse <> 0 Then
strHorse = Nz(DLookup("[HorseName]", "tblHorseInfo", "[HorseID]=" &
idHorse), "")
Else
strHorse = ""
End If
strBodyMsg = "Dear "
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) _
& "Attached is your " & varInvNum & " Dated " & Format(dtInvDate,
"d-mmm-yyyy") _
& IIf(Len(strHorse) > 0, " for " & strHorse, "") & "." _
& eMailSignature("Best Regards", True) & Chr(10) & Chr(10) & Chr(13) _
& DownloadMessage("rtf")
If strMail = "Null" Or Len(strMail) = 0 Or _
DLookup("[MailFlag]", "tblAdminSetup") = False Then
Exit Sub
End If
DoCmd.SendObject acSendReport, Me.Name, acFormatRTF, strMail, , , "Your
Invoice", _
strBodyMsg, blEditMail
Exit Sub
If MsgBox("Do you want to send Email??", vbYesNo + vbDefaultButton2)
= vbYes Then
DoCmd.SendObject acSendReport, Me.Name, acFormatRTF,
strMail, , , _
"Your Invoice", strBodyMsg, True ' ** Change to "False"
later
End If
Exit Sub
Error_Handler:
Select Case Err.Number
Case 2501
Case 2487
Resume Next
Case Else
MsgBox "Error Number: " & Err.Number & Chr(13) _
& "Description: " & Err.Description, , "Untrapped Error"
End Select
End Sub
(1) OwnerStatement, which just creates the email, then you manually send it
(2) Invoice , which sends the report via email on deactivate, I am trying to
get Invoice to just create the email and then you can send it manually like
ownerStatement
Thanks in advance for any help with this......Bob
Both codes are listed below
--------------------------------------------------------
Private Sub SendMailButton_Click()
On Error GoTo ErrorHandler
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, sndReport As String, strCompany As String
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp As
Integer
Select Case Me.OpenArgs
Case "OwnerStatement"
sndReport = "rptOwnerPaymentMethod"
lngID = Nz(Me.cbOwnerName.Column(0), 0)
strMail = OwnerEmailAddress(lngID)
strBodyMsg = "Dear "
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) _
& "Attached is your Statement for the period from " &
Format(Me.tbDateFrom, "d-mmm-yy") _
& " to " & Format(Me.tbDateTo, "d-mmm-yy") & "." _
& eMailSignature("Best Regards", True) & Chr(10) & Chr(10) _
& DownloadMessage("rtf")
DoCmd.SendObject acSendReport, sndReport, acFormatRTF, strMail,
, , "Your Statement", _
strBodyMsg, True
Case Else
Exit Sub
End Select
Exit Sub
ErrorHandler:
msgTitle = "Untrapped Error"
msgBtns = vbExclamation
If Err.Number = 2501 Then 'Prevent error when send is canceled
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
---------------------------------------------------------------------------------
Private Sub Report_Deactivate()
On Error GoTo Error_Handler
Dim lngID As Long, strMail As String, strBodyMsg As String, _
blEditMail As Boolean, dtInvDate As Date, varInvNum As Variant, _
idHorse As Long, strHorse As String
Dim msgPmt As String, msgBtns As Integer, msgTitle As String, msgResp
As Integer
If CurrentProject.AllForms("frmModify").IsLoaded = True Then
lngID = DLookup("OwnerID", "tblInvoice", "InvoiceID = " _
& Form_frmModify.lstModify.Column(0))
ElseIf CurrentProject.AllForms("frmModifyInvoiceClient").IsLoaded = True
Then
lngID = DLookup("OwnerID", "tblInvoice", "InvoiceID = " _
& Form_frmModifyInvoiceClient.lstModify.value)
Else
Exit Sub
End If
strMail = Nz(DLookup("Email", "tblOwnerInfo", "OwnerID = " & lngID), "")
If Not IsEmailOn Or Not IsOwnerWithEmail(lngID) Then
Exit Sub
End If
dtInvDate = Me.tbInvoiceDate
varInvNum = Me.tbInvoiceNumber
idHorse = Nz(Me.tbHorseID, 0)
If idHorse <> 0 Then
strHorse = Nz(DLookup("[HorseName]", "tblHorseInfo", "[HorseID]=" &
idHorse), "")
Else
strHorse = ""
End If
strBodyMsg = "Dear "
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) _
& "Attached is your " & varInvNum & " Dated " & Format(dtInvDate,
"d-mmm-yyyy") _
& IIf(Len(strHorse) > 0, " for " & strHorse, "") & "." _
& eMailSignature("Best Regards", True) & Chr(10) & Chr(10) & Chr(13) _
& DownloadMessage("rtf")
If strMail = "Null" Or Len(strMail) = 0 Or _
DLookup("[MailFlag]", "tblAdminSetup") = False Then
Exit Sub
End If
DoCmd.SendObject acSendReport, Me.Name, acFormatRTF, strMail, , , "Your
Invoice", _
strBodyMsg, blEditMail
Exit Sub
If MsgBox("Do you want to send Email??", vbYesNo + vbDefaultButton2)
= vbYes Then
DoCmd.SendObject acSendReport, Me.Name, acFormatRTF,
strMail, , , _
"Your Invoice", strBodyMsg, True ' ** Change to "False"
later
End If
Exit Sub
Error_Handler:
Select Case Err.Number
Case 2501
Case 2487
Resume Next
Case Else
MsgBox "Error Number: " & Err.Number & Chr(13) _
& "Description: " & Err.Description, , "Untrapped Error"
End Select
End Sub