VBA Default Printer String (language independent)

[alphamax]

Haalt de string op van de default printer en de poort in de juiste taal.
Zodat je deze in kan vullen in excel bij

Application.ActivePrinter

Gets the string of the default printer and port in the right language.
So you can enter it in excel with

Application.ActivePrinter

[SIZE=1]Private Function GetDefaultPrinterNameAndPort()    'am_2020

    Const HKEY_CURRENT_USER = &H80000001

    Dim aON As Variant
    Dim sDefaultPrinterName As String
    Dim sDefaultPrinterPort As String
    Dim sKeyPath As String
    Dim sOn As String
    Dim sValue As String

    sKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts"

    With CreateObject("WbemScripting.SWbemLocator")
        sDefaultPrinterName = .ConnectServer(".", "root\cimv2").ExecQuery("Select * from Win32_Printer Where Default = True").ItemIndex(0).name
        aON = Split(Application.ActivePrinter, " ")
        sOn = aON(UBound(aON) - 1)
        .ConnectServer(".", "root\default").Get("stdregprov").GetStringValue HKEY_CURRENT_USER, sKeyPath, sDefaultPrinterName, sValue
        sDefaultPrinterPort = Mid$(sValue, 10, 5)
    End With

    GetDefaultPrinterNameAndPort = sDefaultPrinterName & " " & sOn & " " & sDefaultPrinterPort

End Function[/SIZE]

Nieuwe verbeterde code / new and improved code.

Excel in Module

Option Explicit

Private Declare Function GetProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Private Function GetDefaultPrinterNameAndPortExcel()
'http://www.java2s.com/Code/VBA-Excel-Access-Word/Windows-API/Getdefaultprinterinformation.htm
    Dim aOn As Variant
    Dim aPrinter As Variant
    Dim sOn As String
    Dim sPrinter As String * 255

    GetProfileStringA "Windows", "Device", "", sPrinter, 254

    aPrinter = Split(Application.Trim(sPrinter), ",")

    aOn = Split(Application.ActivePrinter, " ")
    sOn = aOn(UBound(aOn) - 1)

    GetDefaultPrinterNameAndPortExcel = aPrinter(0) & " " & sOn & " " & aPrinter(2)

End Function

Public Sub Main()

    Dim sDefaultPrinterNameAndPortExcel As String
    sDefaultPrinterNameAndPortExcel = GetDefaultPrinterNameAndPortExcel

End Sub

Access in Module

Option Explicit

Private Declare Function GetProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

Private Function GetDefaultPrinterNameAndPortAccess() As Printer
'http://www.java2s.com/Code/VBA-Access-Access-Word/Windows-API/Getdefaultprinterinformation.htm
'https://stackoverflow.com/questions/30485227/ms-access-change-default-printer-via-vba
    Dim aPrinter As Variant
    Dim sPrinter As String * 255
    Dim oPrinter As Printer

    GetProfileStringA "Windows", "Device", "", sPrinter, 254

    aPrinter = Split(sPrinter, ",")

    For Each oPrinter In Application.Printers
        If oPrinter.DeviceName = aPrinter(0) Then
            Set GetDefaultPrinterNameAndPortAccess = oPrinter
        End If
    Next

End Function

Public Sub Main()

    Dim oDefaultPrinterNameAndPortAccess As Printer
    Set oDefaultPrinterNameAndPortAccess = GetDefaultPrinterNameAndPortAccess

End Sub

 

[edmoor]

Ga ik eens mee spelen.
Dank je wel voor het delen

 

[OctaFish]

In Access heb je een iets andere code nodig, want ActivePrinter kent-ie niet.

Private Function GetDefaultPrinterNameAndPort() As String    'am_2020
Const HKEY_CURRENT_USER = &H80000001
Dim aON As Variant
Dim sDefaultPrinterName As String, sDefaultPrinterPort As String
Dim sKeyPath As String, sOn As String, sValue As String

    sKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts"

    With CreateObject("WbemScripting.SWbemLocator")
        sDefaultPrinterName = .ConnectServer(".", "root\cimv2").ExecQuery("Select * from Win32_Printer Where Default = True").ItemIndex(0).Name
        aON = Split(Application.Printer.DeviceName, " ")
        sOn = aON(UBound(aON) - 1)
        .ConnectServer(".", "root\default").Get("stdregprov").GetStringValue HKEY_CURRENT_USER, sKeyPath, sDefaultPrinterName, sValue
        sDefaultPrinterPort = Mid$(sValue, 10, 5)
    End With

    GetDefaultPrinterNameAndPort = sDefaultPrinterName & " " & sOn & " " & sDefaultPrinterPort

End Function

Sub Tes

tPrinter()
    MsgBox GetDefaultPrinterNameAndPort
End Sub

 

[alphamax]

Nieuwe verbeterde code / new and improved code., zie bericht#1

 

[snb]

Zijn activeprinter en defaultprinter wel voldoende onderscheiden ?

Voor de defaultprinter:

Sub M_snb_default()
  For Each it In GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
    If it.Default Then Exit For
  Next

  MsgBox join(array(it.Name,it.ShareName,it.DriverName,"")," on " & it.PortName & vblf)
End Sub

 

[alphamax]

@snb

Met jouw code voldoe je nooit aan

Application.ActivePrinter = "[The name of your printer] on [port]:"

https://docs.microsoft.com/en-us/office/vba/api/excel.application.activeprinter
Omdat jouw code met de verkeerde poort komt, "USB001" of ziets.

Dit werkt wel met code uit bericht#1

Application.ActivePrinter = "EPSON Stylus SX600FW op Ne03:"

"op" kan in andere talen "on", "auf" etc. zijn.

 

[snb]

Sub M_snb_default()
  sn = split(application.activeprinter)

  For Each it In GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
    If it.Default Then Exit For
  Next

  MsgBox join(array(it.Name,it.ShareName,it.DriverName,"")," " & sn(ubound(sn)-1) & " " & it.PortName & vblf)
End Sub

Desnoods maak je gebruik van Application.LanguageSettings.LanguageID(2)

 

[alphamax]

In jouw code is it.PortName

• PORTPROMPT:
• SHRFAX:
• USB001
• of een ander adres

Terwijl het
Ne0x:
moet zijn, wil het werken met application.activeprinter.

 

[snb]

De defaultprinter staat in het register, inclusief de port.
Van de defaultprinter de activeprinter maken gaat dan met:

Sub M_snb_defaultprinter_active()
  sn = Split(ActivePrinter)
  sp = Split(CreateObject("wscript.shell").regread("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device"), ",")
    
  ActivePrinter = sp(0) & " " & sn(UBound(sn) - 1) & " " & sp(UBound(sp))
End Sub

 

[alphamax]

CreateObject("wscript.shell").regread("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows\Device")

in bericht#9
Doet hetzelfde als

Private Declare Function GetProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long) As Long

in de nieuwe code van bericht#1
Er zijn meerdere wegen die naar rome leiden.