Save Report to PDF file Not working 1

[BubbaJean]

I did a search on "Save Report to PDF file and I followed the messages and now I'm stuck when I click on my button I get the folowing message box "Error Creating PDF File"

Button code below
Private Sub SaveReportToPDF_Click()
Call PrintReportToPDF("rptRFQResponseLetter", "RFQ Response Letter.pdf", "C:\RFQResponseLtrs")
End Sub

The two module below where copied from a early request and response session dealing with the same issue and place in my module section. hope someone can help

' ********Module One titled PDF Export ***********
Public Sub PrintReportToPDF(sReportName As String, sPDFFileName As String, sFileAttachment As String)
Dim sMyDefPrinter As String

' - this will be stored in the Registry (sFileAttachment):

' Read the current default printer and save the value - we will need this later when we reset the Default Printer
sMyDefPrinter = dhReadRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device")

' Change the default printer to the PDF Writer
If Not dhWriteRegistry(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", "Acrobat PDFWriter") Then
GoTo Err_RunReport
End If

' Setting the value for PDFFileName in the registry Prints the Report without the dialog box from appearing
If Not dhWriteRegistry(HKEY_CURRENT_USER, "Software\Adobe\Acrobat PDFWriter", "PDFFileName", sFileAttachment) Then
GoTo Err_RunReport
End If

' Open the Report so it will print it
DoCmd.OpenReport sReportName, acViewNormal

' Change the Printer from PDF Writer back to the default printer
dhWriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", sMyDefPrinter

Exit Sub

Err_RunReport:
' Restore default printer in the Registry
dhWriteRegistry HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", sMyDefPrinter

MsgBox Err.Description, vbCritical, "Error Creating PDF File"


End Sub
***********module 2 titled WindowsRegistry*************

Option Compare Database

'The following functions are required to read/write to the Registry.
'Placefollowing code into a separate module named "WindowsRegistry":

Option Explicit

Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" _
(ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulReserved As Long, ByVal lpClass As String, _
ByVal dwOptions As Long, ByVal samDesired As Long, _
lpSecurityAttributes As Any, phkResult As Long, _
lpdwDisposition As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal dwReserved As Long, lpType As Long, _
lpData As Any, lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal dwReserved As Long, ByVal dwType As Long, _
lpData As Any, ByVal cbData As Long) As Long

Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
(ByVal hKey As Long, ByVal dwIndex As Long, _
ByVal lpName As String, lpcbName As Long, _
lpReserved As Long, ByVal lpClass As String, _
lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long

Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, _
ByVal lpValueName As String, lpcbValueName As Long, _
lpReserved As Long, lpType As Long, _
lpData As Any, lpcbData As Any) As Long

' Registry constants
Global Const dhcSuccess = 0
Global Const dhcRegMaxDataSize = 2048
Global Const dhcRegNone = 0
Global Const dhcRegSz = 1
Global Const dhcRegExpandSz = 2
Global Const dhcRegBinary = 3
Global Const dhcRegDWord = 4
Global Const dhcRegDWordLittleEndian = 4
Global Const dhcRegDWordBigEndian = 5
Global Const dhcRegLink = 6
Global Const dhcRegMultiSz = 7
Global Const dhcRegResourceList = 8
Global Const dhcRegFullResourceDescriptor = 9
Global Const dhcRegResourceRequirementsList = 10
Global Const dhcRegOptionReserved = 0
Global Const dhcRegOptionNonVolatile = 0
Global Const dhcRegOptionVolatile = 1
Global Const dhcRegOptionCreateLink = 2
Global Const dhcRegOptionBackupRestore = 4
Global Const dhcReadControl = &H20000
Global Const dhcKeyQueryValue = &H1
Global Const dhcKeySetValue = &H2
Global Const dhcKeyCreateSubKey = &H4
Global Const dhcKeyEnumerateSubKeys = &H8
Global Const dhcKeyNotify = &H10
Global Const dhcKeyCreateLink = &H20
Global Const dhcKeyRead = dhcKeyQueryValue + dhcKeyEnumerateSubKeys + _
dhcKeyNotify + dhcReadControl
Global Const dhcKeyWrite = dhcKeySetValue + dhcKeyCreateSubKey + dhcReadControl
Global Const dhcKeyExecute = dhcKeyRead
Global Const dhcKeyAllAccess = dhcKeyQueryValue + dhcKeySetValue + _
dhcKeyCreateSubKey + dhcKeyEnumerateSubKeys + _
dhcKeyNotify + dhcKeyCreateLink + dhcReadControl
Global Const dhcHKeyClassesRoot = &H80000000
Global Const dhcHKeyCurrentUser = &H80000001
Global Const dhcHKeyLocalMachine = &H80000002
Global Const dhcHKeyUsers = &H80000003
Global Const dhcHKeyPerformanceData = &H80000004

Public Function dhReadRegistry(ByVal lngKeyToGet As Long, sKeyName As String, sKeyValue As String)
Dim hKeyDesktop As Long
Dim lngResult As Long
Dim strBuffer As String
Dim cb As Long

' Open the Requested Key (sKeyName) in the Registry
lngResult = RegOpenKeyEx(lngKeyToGet, sKeyName, 0&, dhcKeyAllAccess, hKeyDesktop)

' Make sure the call succeeded
If lngResult = dhcSuccess Then
' Create the buffer
strBuffer = Space(255)
cb = Len(strBuffer)

' Read the Key value stored in the Registry
lngResult = RegQueryValueEx(hKeyDesktop, sKeyValue, 0&, dhcRegSz, ByVal strBuffer, cb)

' Check return value
If lngResult = dhcSuccess Then
' Return the current value
dhReadRegistry = Left(strBuffer, cb - 1)
End If

' Close the Registry Key
lngResult = RegCloseKey(hKeyDesktop)
End If

End Function

Public Function dhWriteRegistry(ByVal lngKeyToGet As Long, sKeyName As String, sKeyValue As String, sNewValue As String) As Boolean
Dim hKeyDesktop As Long
Dim lngResult As Long

' Open the Requested Key (sKeyName) in the Registry
lngResult = RegOpenKeyEx(lngKeyToGet, sKeyName, 0&, dhcKeyAllAccess, hKeyDesktop)

' Make sure the call succeeded
If lngResult = dhcSuccess Then
' Save the value to the Registry
lngResult = RegSetValueEx(hKeyDesktop, sKeyValue, 0&, dhcRegSz, ByVal sNewValue, Len(sNewValue))

' Check return value
If lngResult = dhcSuccess Then
' Success
dhWriteRegistry = True
Else
' Failure
dhWriteRegistry = False
End If

' Close the Registry Key
lngResult = RegCloseKey(hKeyDesktop)
End If

End Function

 

[THWatson]

BubbaJean
Know what...I tried that same code and it really messed with my registry. I had to use System Restore to get back to proper functioning.
That doesn't mean it won't work. But it surely caused problems for me.

I'll be interested in seeing a solution to it.

In the meantime, here's my approach...
Use either Adobe (with the ability to create pdf riles) or in my case I use pdfMachine by BroadGun Software (it's free) and print a pdf file and then save it, or e-mail it, or whatever.

Tom

 

[BubbaJean]

Thanks Tom, I think I'm going to scrap what I have and try what u have suggested...wish me luck

 

[PHV]

I think the above code is for version 5 of Adobe.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[BubbaJean]

Tom pdfMachine by BroadGun SW totally ROCKS!!!! Thanks again

 

[THWatson]

Great! You're welcome.

Tom