How to Automatically Create
Adobe PDF Files from Microsoft Access Reports
Hello All. I
recently had the opportunity to install Adobe Acrobat on my work computer
and try to get all of my reports to print automatically in the pdf format.
Let me tell you this was no easy venture. I found a number of examples but
they all seemed to be for Win 98 SE or for Access 97. I am running Access
2000 on Windows 2000 Professional, so all of these examples erred out
somewhere along the way. Even after that I was left with the problem of
writing the code to loop through and produce a number of reports.
Since this was
quite the ordeal, I decided I would share this information and hopefully it
will save someone from hours of frustration.
The first step
is to visit Dev Ashish’s MVP site. He has a great example if you are
running Access 97. It also has some of the tools you will need in
Windows/Access 2000.
http://www.mvps.org/access/reports/rpt0011.htm
You will also
need to download the defaultprt.zip file mentioned in the article.
ftp://ftp.mcwtech.com/defaultprt.zip
I can take no
credit for the above code as it belongs to Ken Getz.
Copy the code
from the first three pale blue boxes into a module. It is much easier in
the long run to copy each box separately and make sure you have some space
between the codes as you paste them. Next open the defaultprt mdb and copy
the modules into your database.
You now have
the basics for changing the default printer to and from the PDFWriter.
Next, with the
help of a gentleman named Al Marshall, I was able to use Adobe Acrobat 5.0’s
feature of being able to print a default path/name from the registry.
You will need
to paste this code into a new module:
Option Compare
Database
Option Compare
Database
Option Explicit
Public Const
REG_SZ As Long = 1
Public Const
REG_DWORD As Long = 4
Public Const
HKEY_CLASSES_ROOT = &H80000000
Public Const
HKEY_CURRENT_USER = &H80000001
Public Const
HKEY_LOCAL_MACHINE = &H80000002
Public Const
HKEY_USERS = &H80000003
Public Const
ERROR_NONE = 0
Public Const
ERROR_BADDB = 1
Public Const
ERROR_BADKEY = 2
Public Const
ERROR_CANTOPEN = 3
Public Const
ERROR_CANTREAD = 4
Public Const
ERROR_CANTWRITE = 5
Public Const
ERROR_OUTOFMEMORY = 6
Public Const
ERROR_ARENA_TRASHED = 7
Public Const
ERROR_ACCESS_DENIED = 8
Public Const
ERROR_INVALID_PARAMETERS = 87
Public Const
ERROR_NO_MORE_ITEMS = 259
Public Const
KEY_QUERY_VALUE = &H1
Public Const
KEY_SET_VALUE = &H2
Public Const
KEY_ALL_ACCESS = &H3F
Public Const
REG_OPTION_NON_VOLATILE = 0
Declare
Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey
As Long) As Long
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
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
Declare
Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA"
(ByVal hKey As Long, ByVal lpValueName As _
String,
ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String,
lpcbData As Long) As Long
Declare
Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA"
(ByVal hKey As Long, ByVal lpValueName As _
String,
ByVal lpReserved As Long, lpType As Long, lpData As _
Long,
lpcbData As Long) As Long
Declare
Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA"
(ByVal hKey As Long, ByVal lpValueName As _
String,
ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long,
lpcbData As Long) As Long
Declare
Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA"
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal
Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String,
ByVal cbData As Long) As Long
Declare
Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA"
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal
Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData
As Long) As Long
Public Function
SetValueEx(ByVal hKey As Long, sValueName As String, _
lType As
Long, vValue As Variant) As Long
Dim
lValue As Long
Dim
sValue As String
Select
Case lType
Case
REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
lType, sValue, Len(sValue))
Case
REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
lType,
lValue, 4)
End
Select
End Function
Function
QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String,
vValue As Variant) As Long
Dim cch
As Long
Dim lrc
As Long
Dim
lType As Long
Dim
lValue As Long
Dim
sValue As String
On Error
GoTo QueryValueExError
'
Determine the size and type of data to be read
lrc =
RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc
<> ERROR_NONE Then Error 5
Select
Case lType
'
For strings
Case
REG_SZ:
sValue = String(cch, 0)
lrc =
RegQueryValueExString(lhKey, szValueName, 0&, lType, _
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
'
For DWORDS
Case
REG_DWORD:
lrc =
RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case
Else
'all other data types not supported
lrc = -1
End
Select
QueryValueExExit:
QueryValueEx = lrc
Exit
Function
QueryValueExError:
Resume
QueryValueExExit
End Function
Public Sub
CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
Dim
hNewKey As Long 'handle to the new key
Dim
lRetVal As Long 'result of the RegCreateKeyEx function
lRetVal
= RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Sub
Public Sub
SetKeyValue(sKeyName As String, sValueName As String, _
vValueSetting As Variant, lValueType As Long)
Dim
lRetVal As Long 'result of the SetValueEx function
Dim hKey
As Long 'handle of open key
'open
the specified key
lRetVal
= RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, _
KEY_SET_VALUE, hKey)
lRetVal
= SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Sub
Public Sub
QueryValue(sKeyName As String, sValueName As String)
Dim
lRetVal As Long 'result of the API functions
Dim hKey
As Long 'handle of opened key
Dim
vValue As Variant 'setting of queried value
lRetVal
= RegOpenKeyEx(HKEY_CURRENT_USER, sKeyName, 0, _
KEY_QUERY_VALUE, hKey)
lRetVal
= QueryValueEx(hKey, sValueName, vValue)
MsgBox
vValue
RegCloseKey (hKey)
End Sub
This will
enable you to write to the registry in the appropriate location. Next I
wrote my own code to send the data to the appropriate key. Here is that
code. This is best placed in the same module as the first item from Ken
Getz.
Function
ReporttoPDF(strPath As String, strReport As String)
On Error
GoTo ReporttoPDF_Error
SetKeyValue
"Software\Adobe\Acrobat PDFWriter", "PDFFilename", strPath, REG_SZ
DoCmd.OpenReport strReport
Call
ResetDefaultPrinter
ReporttoPDF_Error:
Resume Next
End If
End Function
When you write
your own code to loop through whatever report listing you have or from a
form, simply call the change to ChangetoAcrobat function, then the
ReporttoPDF function with the appropriate variables included. This function
also uses the sub function from Ken Getz to change your default printer back
to the original default printer.
For all of
those who stayed with me through this, I hope this helped you in
getting this resolved. Next month I will post the code I use to loop
through my report listing and run all the reports requested.
James La Borde works
in the computer department at a Credit Union,
where he uses Access, SQL Server, VBA, and ODBC daily. He also
teaches online Access classes at
Eclectic
Academy.
|
,
