Changing the Printer in Excel VBA

If you've tried to change the printer in Excel VBA, no doubt you've realised that it needs the printer port in order to work, this looks something like "NE01:". As this changes from computer to computer it can't be hard coded.

Here's a solution that will get the printer port without looping over all possible versions until one works.

Public 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

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

Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private Const dhcKeyAllAccess = &H2003F
Private Const HKEY_CURRENT_USER = &H80000001
Private Const dhcRegSz As String = 1

Function GetPrinterPort(PrinterName As String) As String
    Dim hKeyPrinter As Long
    Dim lngResult As Long
    Dim strBuffer As String
    Dim cb As Long
    
    lngResult = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", 0&, dhcKeyAllAccess, hKeyPrinter)
    
    If lngResult = 0 Then
        strBuffer = Space(255)
        cb = Len(strBuffer)
        
        lngResult = RegQueryValueEx(hKeyPrinter, PrinterName, 0&, dhcRegSz, ByVal strBuffer, cb)

        If lngResult = 0 Then GetPrinterPort = Right(Left(strBuffer, cb), 6)
        
        lngResult = RegCloseKey(hKeyPrinter)
    End If
End Function

Below is an example for calling it:

strPrinterPort = GetPrinterPort("\\KNV-PRT-P0003\PRT-TOSH-Q-01")

Hope this helps someone

Wouldn't this be sufficient ?

 
Sub snb()
 j = 1
 For Each pr In CreateObject("Wscript.network").EnumPrinterConnections
  If j Mod 2 = 0 Then MsgBox printer_snb(pr)
  j = j + 1
 Next
End Sub
 
Function printer_snb(pr)
 On Error Resume Next
 printer_snb = ""
 c01 = CreateObject("wscript.shell").regread("HKCU\Software\Microsoft\Windows NT\CurrentVersion\devices\" & pr)
 If c01 <> "" Then printer_snb = Split(c01, ",")(1)
End Function

Unfortunately no, it won't work for network printers as the slashes in the printer name will be appended to the registry key

But if you can find a way to make it work, I'm all ears, much shorter

Maybe this will do (in analogy to SQL strings)

 
c01 = CreateObject("wscript.shell").regread("HKCU\Software\Microsoft\Windows NT\CurrentVersion\devices\" & Replace("\\KNV-PRT-P0003\PRT-TOSH-Q-01", "\", Chr(92)))

I don't think you have to.

I found a simple solution using Word' VBA-library (although you dislike Word, I like it's VBA-library).
It can be done simply

sub printname()
  msgbox printer_snb("\\KNV-PRT-P0003\PRT-TOSH-Q-01")
end sub 
 
function printer_snb(pr)
  printer_snb=""
  c01=CreateObject("word.application").System.PrivateProfileString("", "HKCU\Software\Microsoft\Windows NT\CurrentVersion\devices", pr)
  if c01<>"" then printer_snb=split(c01,",")(1)
End function

FWIW, I use:

Public Function GetPrinterPort(strPrinterName As String) As String
   Dim objReg As Object, strRegVal As String, strValue As String
   Const HKEY_CURRENT_USER = &H80000001
   Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
   strRegVal = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts\"
   objReg.getstringvalue HKEY_CURRENT_USER, strRegVal, strPrinterName, strValue
   GetPrinterPort = Split(strValue, ",")(1)
End Function