Save Report as PDF, then email Report as Attachment
Windows 7 64bit 
Access 2010 64bit
Hello. What I am trying to do is have the current report be sent when the submit button is hit.
Here is a little background. Users open the program and select the form they need to fill out. An automated number is assigned as the "Report Number" and saved as Report_# in the table. Once the form is filled out, they hit the submit button. I have the code behind the "On Click" of this submit button. What I would like to do is have the data that was just entered into the fields saved to a location on my network and then email that specific report that was just filled out. Below is the code as I have it now.. It is a little messy as I have been trying every which way to get this to work with no success.
Location I would like to save to: S:\Safety\S.R.S. Reports\Initial Reports (I will change to FQDN but pasted this for now).
Example saved file: S:\Safety\S.R.S. Reports\Initial Reports\Event Report #147.pdf
Private Sub Submit_Click()
' Install the error handler.
' On Error GoTo UnexpectedError
Dim EmailAddress As String
Dim Your_Name As String
'Behind a comand button save the report as PDF file
DoCmd.OutputTo acOutputReport, "Single Event Report", acFormatPDF, "S:\Safety\S.R.S. Reports\Initial Reports\Event Report #& Me.Report_# &.pdf", False
'DoCmd.OutputTo acOutputReport, "Single Event Report", "acFormatPDF", "C:\Temp\Single Event Report.pdf", False
Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2 'Must use this to use Delivery Notification
Const cdoAnonymous = 0
Const cdoBasic = 1 ' clear text
Const cdoNTLM = 2 'NTLM
'Delivery Status Notifications
Const cdoDSNDefault = 0 'None
Const cdoDSNNever = 1 'None
Const cdoDSNFailure = 2 'Failure
Const cdoDSNSuccess = 4 'Success
Const cdoDSNDelay = 8 'Delay
Const cdoDSNSuccessFailOrDelay = 14 'Success, failure or delay
Set objMsg = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
Set objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "emailserver"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password"
.Update
End With
strbody = "This is a sample message." & vbCrLf
strbody = strbody & "It was sent using CDO." & vbCrLf
With objMsg
Set .Configuration = objConf
'.To = Me.EmailAddress
.From = "me@me.com"
.Subject = "New Event Report Number " & Me.Report__
strbody = "<B><I>Aloha!</I></B><br><br>" & _
"Your <B><big>Safety Event</big></B> has been successfully submitted; all information you have provided will be treated as confidential.<br><br>" & _
"By taking the time to use this system you do make a difference and your contribution is sincerely appreciated! " & _
"Please allow up to 7 calendar days for a response from our company Safety Officer.<br><br>" & _
"Mahalo!<br><br><br><br>" & _
"Report Number: " & Me.Report__
.HTMLBody = strbody
'use .HTMLBody to send HTML email.
.Addattachment "C:\Temp\Single Event Report & Me.Report_# &.pdf"
'.Fields("urn:schemas:mailheader:disposition-notification-to") = Me.EmailAddress
.Fields("urn:schemas:mailheader:return-receipt-to") = Me.EmailAddress
.DSNOptions = cdoDSNSuccessFailOrDelay
.Fields.Update
.Send
'Exit Sub
'UnexpectedError:
' Describe the error to the user.
' MsgBox "Unexpected error" & _
' Str$(Err.Number) & _
' " in subroutine Form_Event_Reporting_Employee_Basic Submit." & _
' vbCrLf & _
' Err.Description
' Exit Sub
End With
DoCmd.Quit
DoCmd.CloseDatabase
End Sub
Sub MyProc()
On Error GoTo Err_MyProc
Dim db As Database
Dim rst As Recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("MyTable")
'Useful code here.
rst.Close 'Close what you opened.
Exit_MyProc:
Set rst = Nothing 'Deassign all objects.
Set db = Nothing
Exit Sub
Err_MyProc:
'Error handler here.
Resume Exit_MyProc
End Sub
Reply With Quote
