Open Report while creating email

[Bob Vance]

Is it possible to add to this code to open the report as well as creating
this email
Just to check that the report is correct before emailing it
Regards Bob V


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

 

[Tom Wickerath]

Which code are you asking about "to check that the report is correct before
emailing it"? The lines of code to conditionally save the record are
perfectly valid, and should work as long as all required fields are filled in:

If Me.Dirty = True Then
Me.Dirty = False
End If

Have you tried it?


Tom Wickerath
Microsoft Access MVP
http://www.accessmvp.com/TWickerath/
__________________________________________

Is it possible to add to this code to open the report as well as creating
this email
Just to check that the report is correct before emailing it
Regards Bob V


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


--
Thanks in advance for any help with this......Bob
MS Access 2007 accdb
Windows XP Home Edition Ver 5.1 Service Pack 3


.