Home > Enterprise >  Change activeprinter to one with unknown/changing name
Change activeprinter to one with unknown/changing name

Time:03-26

Visual Basic application edition, version 7.1

I would like to:

  • search in the list of all available printers that one whose name contains string "P3005"
  • change activeprinter to that with name contanining "P3005"

It was easy to find a list of available printers' names, and to select that I was searching for (I used the Filter() command). But activeprinter also needs to specify the Ne: port number, and I can't find it

CodePudding user response:

The NE: numbers change on every computer. You can read that from registry.

Software\Microsoft\Windows NT\CurrentVersion\Devices

Here is a function that reads all the printer names:

Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const KEY_READ = &H20019
Global Const REG_OPTION_NON_VOLATILE = &H0
Global Const strPrinterKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
    ByVal hKey As LongPtr, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, phkResult As LongPtr) As Long

Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
    ByVal hKey As LongPtr, ByVal lpValueName As String, ByVal lpReserved As LongPtr, _
    lpType As Long, lpData As Any, lpcbData As Long) As Long

Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long

Public Sub DebugPrintAllPrinters()
    Dim oReg As Object, i As Long
    Dim strKeyPath As String, strValue As String, Msg As String
    Dim arrPrinter As Variant
    
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Devices"
    oReg.EnumValues HKEY_CURRENT_USER, strKeyPath, arrPrinter
    
    For i = 0 To UBound(arrPrinter)
        oReg.GetStringValue HKEY_CURRENT_USER, strKeyPath, arrPrinter(i), strValue
        Msg = Msg & arrPrinter(i) & Replace(strValue, "winspool,", " auf ") & vbCr
    Next
    
    Set oReg = Nothing
    Debug.Print Msg
End Sub
  • Related