Private Sub cmdPrintEmp_Click()
Dim strSave As String
strSave = "EmployeeList_" & Format(Date, "yyyymmdd") & ".PDF"
'Call the function to print it out
If PrintReportToPDF("rpt_Employee", strSave) = True Then
MsgBox "The report has been printed as " & vbCrLf & vbCrLf & _
Replace(strSave, "\\", "\")
Else
MsgBox "The report FAILED to print as a PDF file!", vbCritical, "PDF Failed"
End If
End Sub
Public Function PrintReportToPDF(strReport As String, strSave As String) As Boolean
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Purpose: Print a report to a PDF file
'
' Inputs: strReport Name of report
' strSave Name of PDF file to create
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo ErrHandler
' create the registry entry to set PDF path and filename
WriteRegistryEntry strSave
' print the report - CHECK THAT THE PRINTER NAME IS CORRECT!
Set Application.Printer = Application.Printers("Adobe PDF")
DoCmd.OpenReport strReport, acViewNormal
Application.Printer = Nothing
PrintReportToPDF = True
ExitHere:
Exit Function
ErrHandler:
MsgBox Err.Description
Resume ExitHere
End Function
Public Function WriteRegistryEntry(strPDF As String)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Purpose: Create a registry file in order to set the name and path
' of the PDF file
'
' Reference: Concept developed from post at
' http://www.tek-tips.com/viewthread.cfm?qid=1112992
'
' Assumptions: Registry file is created in same folder as current database,
' then deleted once it has been merged into the registry
'
' Inputs: strPDF Name of PDF file to create
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim strPath As String
Dim x
strPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\", , vbTextCompare))
' make sure reports folder exists
If Dir(strPath & "Reports\", vbDirectory) = "" Then
MkDir strPath & "Reports\"
End If
' registry key needs "\\" in file path
strPDF = strPath & "Reports\" & strPDF
strPDF = Replace(strPDF, "\", "\\")
' delete the registry file if it exists
On Error Resume Next
Kill strPath & "CreatePDF.reg"
' create the registry file
On Error GoTo ErrHandler
Open strPath & "CreatePDF.reg" For Append As #1
Print #1, "Windows Registry Editor Version 5.00"
Print #1, ""
Print #1, "[HKEY_CURRENT_USER\Software\Adobe\Adobe PDF]"
Print #1, """PDFFilename""=" & Chr(34) & strPDF & Chr(34)
Close #1
' merge into registry
x = Shell("regedit.exe /s " & strPath & "CreatePDF.reg", vbHide)
ExitHere:
On Error Resume Next
Close #1
Kill strPath & "CreatePDF.reg"
Exit Function
ErrHandler:
MsgBox Err.Description
Resume ExitHere
End Function
|
