EXCEL VBA - Identify Printer location XXX On Ne01 - Ne16

Here's the function I'm using to get the Printer name (From my previous question on here)

Option Explicit
 
Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
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 RegEnumKeyEx _
Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, ByVal _
lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
lpftLastWriteTime As FILETIME _
) _
As Long
 
Declare Function RegCloseKey _
Lib "advapi32.dll" _
( _
ByVal hKey As Long _
) _
As Long
 
 
Public Function fncEnumInstalledPrintersReg() As Collection
     'returns a collection of the currently installed printers as
     'it appears in the Windows Registry
     '
     'variable declarations
    Dim tmpFunctionResult As Boolean
    Dim aFileTimeStruc As FILETIME
    Dim AddressofOpenKey As Long, aPrinterName As String
    Dim aPrinterIndex As Integer, aPrinterNameLen As Long
     '
     'required API constants
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const HKEY_LOCAL_MACHINE = &H80000002
     '
     'initialise the result of the function to a New (empty) Collection object
    Set fncEnumInstalledPrintersReg = New Collection
     'initialise other variables
    aPrinterIndex = 0
     '
     'open the Windows Registry key that contains the subkeys with the list
     'of currently installed printers
     'This key should be located at: "SYSTEM\CURRENTCONTROLSET\CONTROL\PRINT\PRINTERS"
    tmpFunctionResult = Not CBool _
    ( _
    RegOpenKeyEx _
    ( _
    hKey:=HKEY_LOCAL_MACHINE, _
    lpSubKey:="SYSTEM\CURRENTCONTROLSET\CONTROL\PRINT\PRINTERS", _
    ulOptions:=0, _
    samDesired:=KEY_ENUMERATE_SUB_KEYS, _
    phkResult:=AddressofOpenKey _
    ) _
    )
     '
     'if we could not open/find the "SYSTEM\CURRENTCONTROLSET\CONTROL\PRINT\PRINTERS"
     'Registry key, exit the function; return an empty collection
    If tmpFunctionResult = False Then GoTo ExitFunction
     
     'Loop through all the sub-keys in the Registry key we just opened, and read the
     'entries for the installed printers
    Do
         '
         'pre-initialise a string to hold the first printer name
        aPrinterNameLen = 255 'the length of the string should be
         'large enough to hold any printer name
        aPrinterName = String(aPrinterNameLen, CStr(0))
         '
         'read the value of the next registry sub-key
        tmpFunctionResult = Not CBool _
        ( _
        RegEnumKeyEx _
        ( _
        hKey:=AddressofOpenKey, _
        dwIndex:=aPrinterIndex, _
        lpName:=aPrinterName, _
        lpcbName:=aPrinterNameLen, _
        lpReserved:=0, _
        lpClass:=vbNullString, _
        lpcbClass:=0, _
        lpftLastWriteTime:=aFileTimeStruc _
        ) _
        )
         'prepare to read the next sub-key
        aPrinterIndex = aPrinterIndex + 1
         '
         'for as long as there is a sub-key to read the RegEnumKeyEx function
         'will return tmpFunctionResult=True. If the result is False, there are
         'no more printers and therefore we can exit the loop
        If tmpFunctionResult = False Then Exit Do
         '
         'trim all trailing Null-Strings from the name of the printer
         '(the aPrinterNameLen variable has been updated to indicate the
         ' actual length of the printer name)
        aPrinterName = Left(aPrinterName, aPrinterNameLen)
         
         'add the name of the printer that we have just read in the
         'fncEnumInstalledPrintersReg collection
        On Error Resume Next
        fncEnumInstalledPrintersReg.Add aPrinterName
        On Error GoTo 0
    Loop
     '
     'close the Windows Registry key that we have opened for reading the collection
     'installed printers
    Call RegCloseKey(AddressofOpenKey)
     '
    Exit Function
ExitFunction:
    If Not AddressofOpenKey = 0 Then Call RegCloseKey(AddressofOpenKey)
    Set fncEnumInstalledPrintersReg = Nothing
End Function

Select allOpen in new window

It only returns the bare name without the location, so "HP LaserJet 2300L PS" instead of "HP LaserJet 2300L PS on NeXX:" which is what I need to define that printer to be used to create my .ps file later on. SO I have no problem finding just the name, but I need the "on NeXX" part, thats the bit I'm stuck on ;-)

Ok - take a look at the EnumPrinter() function and see the different parameters that are there - the "fullname" you're looking for may be available.

The Server is one of the parameters (sName).  Here's where I got the original EnumPrinter code:  http://support.microsoft.com/kb/q166008/

Dave

Ok... so.. in the code I'm using
 

    ( _
    RegOpenKeyEx _
    ( _
    hKey:=HKEY_LOCAL_MACHINE, _
    lpSubKey:="SYSTEM\CURRENTCONTROLSET\CONTROL\PRINT\PRINTERS", _
    ulOptions:=0, _
    samDesired:=KEY_ENUMERATE_SUB_KEYS, _
    phkResult:=AddressofOpenKey _
    ) _
    )

Select allOpen in new window

It only pulls the Printer names as that's all that's available from that registry entry.. Also it only pulls Printers on the current machine, not network printers.

But, at HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts
the full information including the order (ports) is stored.. can I change, in my code, the registry key to the current users printerports one and extract from there instead?

I'm not sure myself as I don't understand how the code is extracting the info needed from the registry keys,

Rorya, just saw your post now, 1 tic, that looks like what I'm looking for.. just going to plug it in and check..

Ok, so I've updated the code, Rorya, that is , I think, giving me what I need, but the code won't let me set that as the active printer;

Dim sPSFileName As String 'Name of PS to be created
    Dim sPDFFileName As String 'Name of PDF to be created
    Dim sJobOptions As String
    Dim sCurrentPrinter As String 'Same current printer choice to resume at end
    Dim sPDFVersionAndPort As String 'Version of Adobe
    Dim appDist As cACroDist
    Dim MyFileName As String

    

    Dim aPrinter As Variant
    Dim stPrinter As String
     
     'The name of the printer You want to check up.
    stPrinter = "HP LaserJet 2300L PS"
     
    For Each aPrinter In fncEnumInstalledPrintersReg
        If InStr(aPrinter, stPrinter) Then GoTo PrintLoc
    Next aPrinter

Shell "rundll32 printui.dll,PrintUIEntry /in /b ""HP LaserJet 2300L PS"" /r ""LPT1"" /n ""\\CONORDT\HP LaserJet 2300L PS"""
    
PrintLoc:
 
' Set Full Printer name and Path

   Dim Arr               As Variant
   Dim Device            As Variant
   Dim Devices           As Variant
   Dim sFullPName        As String
   Dim RegObj            As Object
   Dim RegValue          As String
   Const HKEY_CURRENT_USER = &H80000001

   Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
   RegObj.enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr

   For Each Device In Devices
      RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
      sFullPName = Device & " on " & Split(RegValue, ",")(1) & vbCrLf
      If InStr(sFullPName, "HP LaserJet 2300L PS") Then GoTo Printloc1
   Next

' end
 
Printloc1:
  
 
    MyFileName = Trans
     
    Set appDist = New cACroDist
    sCurrentPrinter = Application.ActivePrinter 'Save the currently active printer
    sPDFVersionAndPort = sFullPName 'sCurrentPrinter ' Can't get location right Ne01: etc etc
    sPSFileName = Dir & "\" & MyFileName & ".ps"  'Name of PS file
    sPDFFileName = Dir & "\" & MyFileName & ".pdf" 'Name of PDF
    Application.ActivePrinter = sFullPName
    ActiveSheet.PrintOut ActivePrinter:=sPDFVersionAndPort, _
    PrintToFile:=True, PrToFileName:=sPSFileName 'Prints to PS

Select allOpen in new window

It faults out at:     Application.ActivePrinter = sFullPName  (line 56)

With a 1004: Method 'ActivePrinter' of object '_Application' Failed

Any ideas?

What is the value of sFullPName at the time?

"HP Laserjet 2300L PS on LPT1:"

If you set the printer manually, what does application.activeprinter return?

The exact same..  makes no sense..

If Application.ActivePrinter = sFullPName Then
    MsgBox "TRue!"
    Else
    MsgBox "False"
    End If

This is returning False..  but hovering over, they are identical (See attached jpg)
compare.jpg

Aha!

Doh, should've seen that myself, works now :) Thanks a million!!

Thanks guys, both of you. This one has been on mind a long time., nice to have it working as I wanted at last ;-)<br /><br />Great answers!