Option Explicit

Type PRINTER_INFO_1
    flags As Long
    pPDescription As Long
    pName As Long
    pComment As Long
End Type

Type PRINTER_INFO_5
    pPrinterName As Long
    pPortName As Long
    Attributes As Long
    DeviceNotSelectedTimeout As Long
    TransmissionRetryTimeout As Long
End Type

Private Const PRINTER_ENUM_LOCAL = &H2
Private Declare Function Enumprinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum As Any, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal length&)
Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" (ByVal pszPrinter As String) As Long


Sub Main()
Dim original_printer As String, new_printer As String
    original_printer = ActivePrinter
    new_printer = EnumPrinter
    If new_printer = "None" Then Exit Sub
    SetDefaultPrinter new_printer
    ' qui le oeprazioni con la stampante
    ' printout
    SetDefaultPrinter Left(original_printer, InStr(original_printer, " su ") - 1)
End Sub


Private Function EnumPrinter()
    Dim rc As Long, I As Integer, nSizeOfStruct As Long, Level As Long
    Dim pPrinterEnum() As Byte, pcbNeeded As Long, pcReturned As Long
    Dim PI_1() As PRINTER_INFO_1
    Dim Msg As String
    Dim ChgP As Integer
    Dim v As Variant
    
    Level = 1
    rc = Enumprinters(PRINTER_ENUM_LOCAL, vbNullString, Level, ByVal 0&, 0, pcbNeeded, pcReturned)
    ReDim pPrinterEnum(pcbNeeded - 1) As Byte
    rc = Enumprinters(PRINTER_ENUM_LOCAL, vbNullString, Level, pPrinterEnum(0), pcbNeeded, pcbNeeded, pcReturned)
    ReDim PI_1(pcReturned - 1) As PRINTER_INFO_1
    nSizeOfStruct = Len(PI_1(0))
    Msg = "Digita il numero della nuova stampante predefinita:" & vbCrLf
    For I = 0 To pcReturned - 1
        Call MoveMemory(PI_1(I), pPrinterEnum(nSizeOfStruct * I), nSizeOfStruct)
        Msg = Msg & I + 1 & " > " & gGetStr(PI_1(I).pName, 64) & vbCrLf
    Next I
    v = Val(InputBox(Msg))
    If v = 0 Then EnumPrinter = "None": Exit Function
    ChgP = v
    EnumPrinter = gGetStr(PI_1(ChgP - 1).pName, 64)
End Function

Private Function gGetStr(pString As Long, nBytes As Long) As String
    ReDim BufArray(nBytes) As Byte
    Call MoveMemory(BufArray(0), ByVal pString, nBytes)
    gGetStr = gGetStrBuffer(StrConv(BufArray(), vbUnicode))
End Function

Private Function gGetStrBuffer(sString As String) As String
    If InStr(sString, vbNullChar) Then
        gGetStrBuffer = Left$(sString, InStr(sString, vbNullChar) - 1)
    Else
    gGetStrBuffer = sString
    End If
End Function

Application.Dialogs(xlDialogPrint).Show