Solved

Problem changing default printer on Windows 2008 Server using API and VB Code

Posted on 2009-05-17
6
375 Views
Last Modified: 2012-05-07
The attached code worked successfully on a windows 2003 server.    The 'SaveReportAsPDF' routine grabs the default printer, sets the default printer to the PDF printer set up with ADOBE driver, opens the report and converts it to .pdf, then sets the default printer back.  The application is now running on a virtual windows 2008 server but it will not convert the report to .PDF. The 'SaveReportAsPDF' still grabs the default printer but does not set the default to the ADOBE printer.  The report just prints, does not convert and save to the location.

Uses Adobe 8.0 professional.

Users connect to the 2008 server via RDP.  Users connected to the 2003 server via Citrix Network Neighborhood client.

I have tried referencing the pdf printer by its name"WHMS Adobe PDF" as well as by the full registry name (WHMS Adobe PDF,winspool,Ne00:).  I have also attached the document that is used to set up the PDF printer for additional reference.

This is code I had gotten from tek-tips and has worked well.  I've added a file with samples of the entries that I have tried.  It seems like there might be something with Windows 2008 that is preventing the change to the default printer.
Option Compare Database

Option Explicit

'copied from Tek-tips

'http://www.tek-tips.com/faqs.cfm?pid=703&fid=2533

 

'**********************************************************

 

   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)

 

On Error GoTo ErrHandler:

 

    Dim strOldDefault As String

    Dim strPDFPrinter As String

    Dim strACCESSPath As String

    Dim strDistillerReg As String

    

    'PDF printer name

    strPDFPrinter = "WHMS Adobe PDF"

    

    'path to MSAccess exe

    strACCESSPath = "C:\Program Files\Microsoft Office\OFFICE11\MSACCESS.EXE"

    

    'get the path to the registry entry to the distiller

    strDistillerReg = "Software\Adobe\Acrobat Distiller\PrinterJobControl"

    

    'capture the existing default printer

    strOldDefault = QueryKey("Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device")

    

    'set the new default printer

    SetKeyValue "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", strPDFPrinter, REG_SZ

    

    'save the report

    SetKeyValue strDistillerReg, strACCESSPath, strPath, REG_SZ

 

    DoCmd.OpenReport strReportName

    

ExitSub:

    'reset the default back to the original default printer

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

    Exit Sub

    

ErrHandler:

    On Error Resume Next

    Resume ExitSub

 

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

 

'**********************************************************

Open in new window

pdfvalues.txt
SetUpWHMSPDFPrinter.doc
0
Comment
Question by:JANWIL78
  • 3
  • 3
6 Comments
 
LVL 74

Accepted Solution

by:
Jeffrey Coachman earned 50 total points
ID: 24410152
Is using another conversion utility an option?

I use this with no problems whatsoever.
http://www.lebans.com/reporttopdf.htm

Sample attached

JeffCoachman
Access-BasicSelectOneSingleRepor.mdb
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24410171
And by the way...

Welcome to Experts-Exchange.com
;-)

Just FYI:
Using ALL CAPS is considered "SHOUTING", and as such, is taken as being rude, or trying to make your question standout.

In fact, most Experts here ignore ALL CAPS postings altogether.

JeffCoachman
0
 

Author Comment

by:JANWIL78
ID: 24421813
I had downloaded and reviewed the sample from http://www.lebans.com/reporttopdf.htm during my research on this problem.  Wasn't sure if it worked on Windows server 2008 because it seemed similar to what I was already using.  Thought I would see if anyone had a solution to updating the 2008 registry/setting the default before trying a different approach.  I'll go ahead and give that a shot and see if the dlls work on Windows Server 2008.  Thank you.
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 

Author Comment

by:JANWIL78
ID: 24443637
The application at http://www.lebans.com/reporttopdf.htm did work on Windows Server 2008.  It did convert the ACCESS report to the pdf file as needed.
0
 

Author Closing Comment

by:JANWIL78
ID: 31582476
The lebans application does work on Windows 2008 Server.  It did solve the problem.  I am still curious as to how to get the original to work on Windows 2008 Server but am moving on.  Thank you.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24444624
<I am still curious as to how to get the original to work on Windows 2008 Server but am moving on. >
;-)
I know the feeling.

Glad I could help.

;-)
JeffCoachman
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

If you are having problems installing printer drivers, or if documents repeatedly get stuck in the print queue even after re-installing the printer drivers, then follow these steps to solve the problems. Please note that the steps are shown both for…
Hyper-convergence systems have taken the IT world by storm and have quickly started to change our point of view of how the data center should and could be architected. In this article, I’ll explain the benefits of employing a hyper-converged system …
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now