Private Sub EmailKeeperCardBtn_Click()
On Error GoTo MyErrorHandler
Me.Refresh
Dim stReport As String
Dim stWhere As String
Dim stSubject As String
Dim stEmailMessage As String
Dim stCaption As String
Dim myPath As String
'This sets the strings for each part of the email
stEmailMessage = "Please see the attached updates for item#" & Me.ITEMID
stSubject = "Updates to Item#" & Me.ITEMID'
stReport = "RptITEM"
'This will change the caption of the report (which is what the filename is saved as) to something meaningful - in this case the numbers and date of thereport. If you have multiple people making these reports at once, and would have multiple ones with the same date/time stamp, you should modify this a little to prevent overwriting files.
stCaption = Me.ITEMID & " " & Me.NOTEID & " #" & " " & Format(Now(), "yyyy-mm-dd") & " " & Format(Now(), "hh-nn")
myPath = "C:\MyPath\My Folder\"
stWhere = "ITEMID = " & Me.ITEMID
DoCmd.OpenReport stReport, acViewPreview, , stWhere, acWindowNormal, ""
Reports![RptITEM].Caption = stCaption 'Renames The report and adds ID field
'In my environment, some users have Office 2010, and other still have 2007 and can't handle PDFs. This code checks which version and sends an XPS file for 2007 users instead (we, for whatever reason, use XPS here still a bit).
If Access.Version > 13 Then
DoCmd.SendObject acSendReport, stReport, acFormatPDF, , , , stSubject, stEmailMessage, True, ""
DoCmd.OutputTo acOutputReport, stReport, acFormatPDF, myPath & stCaption & ".pdf", False, , , acExportQualityPrint
Else
DoCmd.SendObject acSendReport, stReport, acFormatXPS, , , , stSubject, stEmailMessage, True, ""
DoCmd.OutputTo acOutputReport, , acFormatXPS, myPath & ".xps", False
End If
Exit Sub
MyErrorHandler:
'Ignoring this error, mostly. You may not want to do this,
If Err.Number = 2501 Then
Beep
Beep
Exit Sub
Else
MsgBox Err.Number & ":" & Err.Description, vbOKOnly
End If
End Sub