Programmatically create a PDF from Access 2002 7

[djRixMix]

Environment: Microsoft Access 2002 and Acrobat 6.0 on Windows XP.

I'm writing a progran that creates a massive amount of reports to be sent via email to differents persons. I am trying to output these Access reports directly in PDF files without any intervention whatsoever from the user but the Adobe PDF driver keeps prompting me for a file name and then it opens Acrobat Reader.

How can I modify the driver's properties programmatically to prevent it from asking any question to the user and also to prevent it from opening Acrobat Reader after the PDF file is created without having to permanently modify the users default set up?

In other words: I want my program to run without leaving anything changed behind it on the user's station.

 

[ck1999]

filename = "C:\my documents\reports\" & customernumber
SendKeys "^p~" & FileName & "~", true

You will have to do a loop in a vba. I have used this code to loop through all the customer numbers and printed a report for each customer number and then saved the report as the customernumber.pdf.


This will print a report and fill in the popup box. Although before running this code you may need to do page setup and uncheck the view pdf after and also to select the active printer


Hope this helps

Take a look at thread707-860631 this is what i used and just modified the code

Chris

 

[djRixMix]

HERE IS THE SOLUTION AT LAST!!! AT LONG LAST!!!
WORKS WITH ACCESS 2002 and Acrobat 6.0 and up...

'===========================================================
' Code begins here
'
' The function to call is RunReportAsPDF
'
' It requires 2 parameters: the Access Report to run
' the PDF file name
'
' Enjoy!
'
' Eric Provencher
'===========================================================

Option Compare Database

Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (dest As Any, _
source As Any, _
ByVal numBytes As Long)

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.dll" (ByVal hKey As Long) As Long

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
Alias "RegCreateKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
ByVal lpSecurityAttributes As Long, _
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 lpReserved 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 Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long

Private Declare Function apiFindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" (ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal lpResult As String) As Long

Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_MULTI_SZ = 7
Const ERROR_MORE_DATA = 234

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002

Const KEY_READ = &H20019 ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not
' SYNCHRONIZE))

Const KEY_WRITE = &H20006 '((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
' KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Public Function RunReportAsPDF(prmRptName As String, _
prmPdfName As String) As Boolean

' Returns TRUE if a PDF file has been created

Dim AdobeDevice As String
Dim strDefaultPrinter As String

'Find the Acrobat PDF device

AdobeDevice = GetRegistryValue(HKEY_CURRENT_USER, _
"Software\Microsoft\WIndows NT\CurrentVersion\Devices", _
"Adobe PDF")

If AdobeDevice = "" Then ' The device was not found
MsgBox "You must install Acrobat Writer before using this feature"
RunReportAsPDF = False
Exit Function
End If

' get current default printer.
strDefaultPrinter = Application.Printer.DeviceName

Set Application.Printer = Application.Printers("Adobe PDF")

'Create the Registry Key where Acrobat looks for a file name
CreateNewRegistryKey HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl"

'Put the output filename where Acrobat could find it
SetRegistryValue HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl", _
Find_Exe_Name(CurrentDb.Name, CurrentDb.Name), _
prmPdfName

On Error GoTo Err_handler

DoCmd.OpenReport prmRptName, acViewNormal 'Run the report

While Len(Dir(prmPdfName)) = 0 ' Wait for the PDF to actually exist
DoEvents
Wend

RunReportAsPDF = True ' Mission accomplished!

Normal_Exit:

Set Application.Printer = Application.Printers(strDefaultPrinter) ' Restore default printer

On Error GoTo 0

Exit Function

Err_handler:

If Err.Number = 2501 Then ' The report did not run properly (ex NO DATA)
RunReportAsPDF = False
Resume Normal_Exit
Else
RunReportAsPDF = False ' The report did not run properly (anything else!)
MsgBox "Unexpected error #" & Err.Number & " - " & Err.Description
Resume Normal_Exit
End If

End Function

Public Function Find_Exe_Name(prmFile As String, _
prmDir As String) As String

Dim Return_Code As Long
Dim Return_Value As String

Return_Value = Space(260)
Return_Code = apiFindExecutable(prmFile, prmDir, Return_Value)

If Return_Code > 32 Then
Find_Exe_Name = Return_Value
Else
Find_Exe_Name = "Error: File Not Found"
End If

End Function

Public Sub CreateNewRegistryKey(prmPredefKey As Long, _
prmNewKey As String)

' Example #1: CreateNewRegistryKey HKEY_CURRENT_USER, "TestKey"
'
' Create a key called TestKey immediately under HKEY_CURRENT_USER.
'
' Example #2: CreateNewRegistryKey HKEY_LOCAL_MACHINE, "TestKey\SubKey1\SubKey2"
'
' Creates three-nested keys beginning with TestKey immediately under
' HKEY_LOCAL_MACHINE, SubKey1 subordinate to TestKey, and SubKey3 under SubKey2.
'
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx function

lRetVal = RegOpenKeyEx(prmPredefKey, prmNewKey, 0, KEY_ALL_ACCESS, hKey)

If lRetVal <> 5 Then
lRetVal = RegCreateKeyEx(prmPredefKey, prmNewKey, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
End If

RegCloseKey (hNewKey)

End Sub

Function GetRegistryValue(ByVal hKey As Long, _
ByVal KeyName As String, _
ByVal ValueName As String, _
Optional DefaultValue As Variant) As Variant

Dim handle As Long
Dim resLong As Long
Dim resString As String
Dim resBinary() As Byte
Dim length As Long
Dim retVal As Long
Dim valueType As Long

' Read a Registry value
'
' Use KeyName = "" for the default value
' If the value isn't there, it returns the DefaultValue
' argument, or Empty if the argument has been omitted
'
' Supports DWORD, REG_SZ, REG_EXPAND_SZ, REG_BINARY and REG_MULTI_SZ
' REG_MULTI_SZ values are returned as a null-delimited stream of strings
' (VB6 users can use SPlit to convert to an array of string)


' Prepare the default result
GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, DefaultValue)

' Open the key, exit if not found.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
Exit Function
End If

' prepare a 1K receiving resBinary
length = 1024
ReDim resBinary(0 To length - 1) As Byte

' read the registry key
retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), length)

' if resBinary was too small, try again
If retVal = ERROR_MORE_DATA Then
' enlarge the resBinary, and read the value again
ReDim resBinary(0 To length - 1) As Byte
retVal = RegQueryValueEx(handle, ValueName, 0, valueType, resBinary(0), _
length)
End If

' return a value corresponding to the value type
Select Case valueType
Case REG_DWORD
CopyMemory resLong, resBinary(0), 4
GetRegistryValue = resLong
Case REG_SZ, REG_EXPAND_SZ
' copy everything but the trailing null char
resString = Space$(length - 1)
CopyMemory ByVal resString, resBinary(0), length - 1
GetRegistryValue = resString
Case REG_BINARY
' resize the result resBinary
If length <> UBound(resBinary) + 1 Then
ReDim Preserve resBinary(0 To length - 1) As Byte
End If
GetRegistryValue = resBinary()
Case REG_MULTI_SZ
' copy everything but the 2 trailing null chars
resString = Space$(length - 2)
CopyMemory ByVal resString, resBinary(0), length - 2
GetRegistryValue = resString
Case Else
GetRegistryValue = ""
' RegCloseKey handle
' Err.Raise 1001, , "Unsupported value type"
End Select

RegCloseKey handle ' close the registry key

End Function

Function SetRegistryValue(ByVal hKey As Long, _
ByVal KeyName As String, _
ByVal ValueName As String, _
Value As Variant) As Boolean

' Write or Create a Registry value
' returns True if successful
'
' Use KeyName = "" for the default value
'
' Value can be an integer value (REG_DWORD), a string (REG_SZ)
' or an array of binary (REG_BINARY). Raises an error otherwise.

Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim byteValue As Byte
Dim length As Long
Dim retVal As Long

' Open the key, exit if not found
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then
Exit Function
End If

' three cases, according to the data type in Value
Select Case VarType(Value)
Case vbInteger, vbLong
lngValue = Value
retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD, lngValue, 4)
Case vbString
strValue = Value
retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, Len(strValue))
Case vbArray
binValue = Value
length = UBound(binValue) - LBound(binValue) + 1
retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, binValue(LBound(binValue)), length)
Case vbByte
byteValue = Value
length = 1
retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, byteValue, length)
Case Else
RegCloseKey handle
Err.Raise 1001, , "Unsupported value type"
End Select

RegCloseKey handle ' Close the key and signal success

SetRegistryValue = (retVal = 0) ' signal success if the value was written correctly

End Function

'=============== CODE ENDS HERE ==========================

 

[giannit]

Hi djRixMix!

I have found your piece of code very useful!

I have another question about.

How to avoid programmatically the automatic launch of Acrobat reader at the end the PDF creation without using the printer option (that disable it globally) ?

Thanks in advance!
Gianni

 

[bmcilroy]

Good morning djRixMix. Any chance we can adapt this to printing a sheet from an Excel file? I'm sure it can be done, but I need your help. Thanks in advance.

 

[djRixMix]

If anyone finds out how to solve Giannit's problem let me know!!!

I'm no Excel guru but I think that it should apply to any program. Here's how it basically works:

You must set a Registry entry that contains the complete name of the current application ("c:\fullpath\msaccess.exe") and the name of the output file ("d:\fullpath\toto.pdf").

The next time that the specified EXE file tries to output a file using PDF Writer, Adobe PdfWriter will use the output file name specified previously and create the PDF at the proper location. Then it will remove the Registry Entry that contained the output file name.

If you send 2 files to the PDF Writer in a row, the second one will not be able to use the entry set for the first one.

In the code sample the registry Entry is set with the following statements:


SetRegistryValue HKEY_CURRENT_USER, _
"Software\Adobe\Acrobat Distiller\PrinterJobControl", _
Find_Exe_Name(CurrentDb.Name, CurrentDb.Name), _
prmPdfName

I hope it helped you understand what i did to solve that mystery!!!

DjRixMix

 

[sgardiner1]

I find that this method doesn't work for my system. I have adobe acrobat professional 6 installed on windows xp with service pack 2.

Even if this registry key is created, the "save as" dialog box still opens and prompts for a filename. It doesn't work in any application even when you set the registry key by hand and use print.

If there is something that I am missing please let me know.

 

[sgardiner1]

see pdf help file from adobe at

http://partners.adobe.com/public/de...tion_apis_and_specs/DistillerAPIReference.pdf

This document makes me wonder if I need to have some API installed, I have the v6 distiller, but not the sdk.

 

[djRixMix]

The solution I posted works with Adobe 6 and Access 2002 without having to install anything else.

I can't imagine why it does not work on your station.

I even tried it on stations where the user is not "administrator".

Is it possible that the name put in the new registry key is not the exact full name of your Microsoft Access application?

 

[sgardiner1]

When I stop on a breakpoint in the VBA code, I noticed that there is an unprintable character at the end of the path to the executable; i.e., c:\program files\...\MSACCESS.exe?. So that might be the problem in that case.

However, before I fixed that I was trying with other applications specifically, notepad, and nothing happened. HOWEVER, I just tried again with WORDPAD and that works! So I'll check the exe name in MSACCESS and see what happens.

 

[BDPNupe]

I am getting an Error on the following declarations:

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002

HELP!!!

 

[djRixMix]

Would it be too much to ask what the error message is?

 

[BDPNupe]

Thanks for the fast response.

First of all let me thank you for your desire to help.

I am running Access 2003 Service Pack 1 on Windows 2000 with Adobe Acrobat 5.0.

I am getting two error messages

1) If I run the code as written I get:

"Constants, fixed length Strings, arrays, user defined types and Declare statements are not allowed as Public Members of Object Members"

2) If I remove the public Designation from the variables in my previous post I get:

"You must install Acrobat Writer before using this feature"

Doesn't the full version of Adobe Acrobat inclue Adobe acrobat writer?

 

[djRixMix]

Ok... I'm afraid I won't be very helpful on this one...

First: I never tested my solution with Acrobat 5 nor Access 2003 so I'm not even sure it works.

Second: I don't have a clue what is installed with the "full" version of Acrobat but I assume Writer is included.

Third: You will have to check the name of the driver when you install it though... I kind of recall that it is different from the Acrobat 6.0 driver name... My solution is looking for the device by name therefore you might experience difficulties at that level too.

Eric

 

[sgardiner1]

I have used access 2003 sp1 and this code works OK.

acrobat 5 works in a similar way with different registry keys and a differently named printer, this code won't work for acrobat 5. But the code at

http://groups.google.com/group/comp...ast_SpamBegone_.net&hl=en&lr=&c2coff=1&rnum=1

and use the PDFWriter method. A search for code relating to PDFWriter (this is the name of the PDF printer in acrobat 5)


on another note,

also, I found that this code doesn't work if you use a UNC path. The report doesn't print and acrobat pops up a request for a filename.

 

[BDPNupe]

Okay I am going with the SendKeys method suggested in the second Post BUT it is not saving the file even though I am "sending" the enter keystrokes.

HELP!


The code is posted below.

Private Sub Command25_Click()
Dim tmpPrinter As Printer
Set tmpPrinter = Application.Printer 'Default Printer
Set Application.Printer = Application.Printers("Adobe PDF") 'Change the application printer to adobe
DoCmd.OpenReport "RptPenalized", acViewPreview 'Open the Report in Priview Mode
Filename = "C:\"
SendKeys "^p~" & Filename & "~", False 'Send the Open Report to a .pdf file
DoCmd.Close acReport, "RptPenalized" 'Close report
Set tmpPrinter = Application.Printer
Set Application.Printer = Application.Printers(0) ' Restore Default printers
End Sub

 

[Wallyworld99999]

DjRixMix,

Just wanted to say thanks for this helpful posting. I am also trying to solve a minor problem.

I am trying to remove some of this code and place it into an area so that it is accessible by other forms that I have in my Access DB (so I don't have to duplicate the code).

However when I separate the code out I keep getting a variable not defined error in the Public Sub CreateNewRegistryKey routine specifically pointing to "KEY_ALL_ACCESS" as the variable not defined. Any clues?

 

[Wallyworld99999]

DjRixMix,

I solve the matter the "Option Explicit" statement was getting me. Thanks for the great solution!

 

[BDPNupe]

The code above does indeed work with Acrobat 6.0 and above!

Thanks Eric.

Now how do I close the Acrobat when it opens automatically?

 

[djRixMix]

Unfortunately I haven't a way to programatically prevent Acrobat from opening.

The only way I found was to manually modify Adobe's Printing Preferences and uncheck the "View Adobe PDF results" check box...

Anyone has an other solution that does not involve SEND KEYS? )

Eric