By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
455,611 Members | 1,468 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 455,611 IT Pros & Developers. It's quick & easy.

Creating PDFs from Access 2003 on Windows XP

P: n/a
I used to be able to create PDFs, automatically save them to a file,
and mail them out to people. This was on Access 97 with Windows NT.
We've changed to Windows XP and Access 2003. Doesn't work anymore.
Part of the problem is that the users have no access to the registry
and can only save files on the C:\ drive to their My Documents folder.
I found this code on the web, but it doesn't work either. The files
continue to print out of my printer instead of making a PDF. I put the
entire code at the bottom, but here is the part I'm calling:
Public Sub SaveReportAsPDF(strReportName As String, strPath As String)

If Dir("C:\defaultprinter.bat") <> "defaultprinter.bat" Then
Call AddDefaultPrinterBat
sSleep (5000)
End If

Dim strOldDefault As String
Dim RetVal As Variant

strOldDefault = _
Left(QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device"), _
InStr(1, QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", _
"Device"), ",") - 1)

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & "Acrobat
PDFWriter" & Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", "Acrobat
PDFWriter,winspool,LPT1:", REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename",
strPath, REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0,
REG_SZ

sSleep (5000)

DoCmd.OpenReport strReportName

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & strOldDefault &
Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", strOldDefault, REG_SZ

End Sub
1. What is sSleep? When I compile it kicks out.
2. The 'defaultprinter.bat' thing doesn't work and it leaves an open
DOS screen on my PC.
HELP! I'm dying here.

Thanks in advance,
Laura


The entire code:

' ################################################## #######
Option Compare Database

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 Sub SaveReportAsPDF(strReportName As String, strPath As String)

If Dir("C:\defaultprinter.bat") <> "defaultprinter.bat" Then
Call AddDefaultPrinterBat
sSleep (5000)
End If

Dim strOldDefault As String
Dim RetVal As Variant

strOldDefault = _
Left(QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device"), _
InStr(1, QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", _
"Device"), ",") - 1)

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & "Acrobat
PDFWriter" & Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", "Acrobat
PDFWriter,winspool,LPT1:", REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename",
strPath, REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0,
REG_SZ

sSleep (5000)

DoCmd.OpenReport strReportName

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & strOldDefault &
Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", strOldDefault, REG_SZ

End Sub

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 Function 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 Function

Public Function 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 Function

Public Function QueryKey(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)

QueryKey = vValue

RegCloseKey (hKey)

End Function

Public Sub AddDefaultPrinterBat()

Dim hFile As Long

hFile = FreeFile

Open "C:\defaultprinter.bat" For Output Access Write As hFile

Print #hFile, "rundll32 printui.dll,PrintUIEntry /y /n %1"

Close hFile

End Sub
' ################################################## #######

Nov 13 '05 #1
Share this Question
Share on Google+
4 Replies


P: n/a
MaC

Uzytkownik "musicloverlch" <lh****@gmail.com> napisal w wiadomosci
news:11********************@o13g2000cwo.googlegrou ps.com...
I used to be able to create PDFs, automatically save them to a file,
and mail them out to people. This was on Access 97 with Windows NT.
We've changed to Windows XP and Access 2003. Doesn't work anymore.
Part of the problem is that the users have no access to the registry
and can only save files on the C:\ drive to their My Documents folder.
I found this code on the web, but it doesn't work either. The files
continue to print out of my printer instead of making a PDF. I put the
entire code at the bottom, but here is the part I'm calling:
Public Sub SaveReportAsPDF(strReportName As String, strPath As String)

If Dir("C:\defaultprinter.bat") <> "defaultprinter.bat" Then
Call AddDefaultPrinterBat
sSleep (5000)
End If

Dim strOldDefault As String
Dim RetVal As Variant

strOldDefault = _
Left(QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device"), _
InStr(1, QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", _
"Device"), ",") - 1)

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & "Acrobat
PDFWriter" & Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", "Acrobat
PDFWriter,winspool,LPT1:", REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename",
strPath, REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0,
REG_SZ

sSleep (5000)

DoCmd.OpenReport strReportName

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & strOldDefault &
Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", strOldDefault, REG_SZ

End Sub
1. What is sSleep? When I compile it kicks out.
2. The 'defaultprinter.bat' thing doesn't work and it leaves an open
DOS screen on my PC.
HELP! I'm dying here.

Thanks in advance,
Laura


The entire code:

' ################################################## #######
Option Compare Database

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 Sub SaveReportAsPDF(strReportName As String, strPath As String)

If Dir("C:\defaultprinter.bat") <> "defaultprinter.bat" Then
Call AddDefaultPrinterBat
sSleep (5000)
End If

Dim strOldDefault As String
Dim RetVal As Variant

strOldDefault = _
Left(QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device"), _
InStr(1, QueryKey("Software\Microsoft\Windows
NT\CurrentVersion\Windows", _
"Device"), ",") - 1)

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & "Acrobat
PDFWriter" & Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", "Acrobat
PDFWriter,winspool,LPT1:", REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "PDFFilename",
strPath, REG_SZ

SetKeyValue "Software\Adobe\Acrobat PDFWriter", "bExecViewer", 0,
REG_SZ

sSleep (5000)

DoCmd.OpenReport strReportName

RetVal = Shell("C:\defaultprinter.bat " & Chr(34) & strOldDefault &
Chr(34), vbMinimizedNoFocus)

'SetKeyValue "Software\Microsoft\Windows
NT\CurrentVersion\Windows", "Device", strOldDefault, REG_SZ

End Sub

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 Function 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 Function

Public Function 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 Function

Public Function QueryKey(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)

QueryKey = vValue

RegCloseKey (hKey)

End Function

Public Sub AddDefaultPrinterBat()

Dim hFile As Long

hFile = FreeFile

Open "C:\defaultprinter.bat" For Output Access Write As hFile

Print #hFile, "rundll32 printui.dll,PrintUIEntry /y /n %1"

Close hFile

End Sub
' ################################################## #######


sSleep seems to be an API function Sleep (it stops code executing for some
time ,for example sSleep(5000) making it for 5 seconds ).
Probably you don't have the properly declaration.
I suppose it can be done as in following code:

---Posted by Dev Ashish---

----------------------------------------
API: Make it "Sleep"
----------------------------------------

More than a few people have asked me if an alternative to DoEvents
exists to implement a wait period in Access. (DoEvents yields execution so
that the operating system can process other events.)

The answer is yes, the Sleep API can be used for this. Look at the
sample sTestSleep Sub. When you run it, you'll notice a delay beforethe
Msgbox appears on screen. The duration can be increased/decreased bychanging
the constant cTime to a corressponding higher/lower value.

For normal use from within your code, simply place a call to the sSleep
sub with an appropriate time in milliseconds.

'***************** Code Start *******************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Declare Sub sapiSleep Lib "kernel32" _
Alias "Sleep" _
(ByVal dwMilliseconds As Long)

Sub sSleep(lngMilliSec As Long)
If lngMilliSec > 0 Then
Call sapiSleep(lngMilliSec)
End If
End Sub

Sub sTestSleep()
Const cTIME = 1000 'in MilliSeconds
Call sSleep(cTIME)
MsgBox "Before this Msgbox, I was asleep for " _
& cTIME & " Milliseconds."
End Sub
'***************** Code End *********************

Hi
Mac

Nov 13 '05 #2

P: n/a
A pertinent question is: "Is Adobe Acrobat PDF Writer installed on each
user's machine?" It appears that is what would be used to write the PDF.

Just as an aside, Microsoft recently announced that most components of the
next version of Office (currently called Office 12) will have native
capability to create PDF files, without having Adobe Acrobat or other
third-party software installed. They did _not_ say they were going to
retrofit that to earlier versions.

Larry Linson
Microsoft Access MVP

"musicloverlch" <lh****@gmail.com> wrote in message
news:11********************@o13g2000cwo.googlegrou ps.com...
I used to be able to create PDFs, automatically save them to a file,
and mail them out to people. This was on Access 97 with Windows NT.
We've changed to Windows XP and Access 2003. Doesn't work anymore.

Nov 13 '05 #3

P: n/a
On Wed, 26 Oct 2005 20:46:25 GMT, "Larry Linson"
<bo*****@localhost.not> wrote:
A pertinent question is: "Is Adobe Acrobat PDF Writer installed on each
user's machine?" It appears that is what would be used to write the PDF.

Just as an aside, Microsoft recently announced that most components of the
next version of Office (currently called Office 12) will have native
capability to create PDF files, without having Adobe Acrobat or other
third-party software installed. They did _not_ say they were going to
retrofit that to earlier versions.


Be very wary. OO2.0 has the ability already built in. A simple page
is 17k. It is only 2k in PDFCREATOR.

Built-in != Good to Use

George
Nov 13 '05 #4

P: n/a
Yes, PDF Writer is installed on each users machine. We can create PDFs
fine, just can't print one to a file name.

Thanks so responding.
:-)

Nov 13 '05 #5

This discussion thread is closed

Replies have been disabled for this discussion.