Sub PrintRicevuta(numeroricevuta As String)
'Mail merge e stampa su stampante di default

'On Error GoTo ErrorHandler

' open template in Word
Dim filepath, SQLStmt, WorkbookName As String
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Set WordApp = New Word.Application
filepath = ThisWorkbook.Path
WorkbookName = ThisWorkbook.FullName
Debug.Print filepath, numeroricevuta
With WordApp
    .Visible = True
    Set WordDoc = .Documents.Open(filepath & "stamparicevuta.docx")
End With
SQLStmt = "SELECT * FROM `Ricevute$` WHERE [Numero] = " & numeroricevuta
'MailMerge selected records from table to Word document
With WordDoc
    With .MailMerge
        .MainDocumentType = wdFormLetters
        .OpenDataSource Name:=WorkbookName, _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:="rangericevute", _
        SQLStatement:=SQLStmt, SQLStatement1:="", _
        SubType:=wdMergeSubTypeAccess
   
        .SuppressBlankLines = True
                      
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        
   'Selezionare la stampante. Per questa funzione, la stampa
   'viene diretta sulla stampante di rete SAMSUNG ML-8610
   ' Bisogna trovare il nome completo di windows per questa stampante
   
    Dim sPrinter As String
    Dim sDefaultPrinter As String
    Debug.Print "Default printer: ", Application.ActivePrinter
    'store default printer
    sDefaultPrinter = Application.ActivePrinter
    'Get complete name using known characters
    sPrinter = GetPrinterFullName("Stylus Office")
    If sPrinter = vbNullString Then ' no match
        Debug.Print "No match"
    Else
        .Application.ActivePrinter = sPrinter
        Debug.Print "Temp printer: ", .Application.ActivePrinter
        'execute merge and Print with temp printer
        Debug.Print "Default printer: ", Application.ActivePrinter
        .Destination = wdSendToPrinter
        .Execute Pause:=False
        .Application.ActivePrinter = sDefaultPrinter ' restore default printer
    End If
    End With
           
End With
Application.ActivePrinter = sDefaultPrinter ' restore default printer
WordDoc.Close SaveChanges:=False
WordApp.Quit

ErrorHandlerExit:
Exit Sub
ErrorHandler:
If Err = 429 Then
'word is not running; open word with CreateObject
Set appWord = CreateObject(Class:="Word.Application")
End If

End Sub

*************************************************
Public Function GetPrinterFullName(Printer As String) As String
 
    ' This function returns the full name of the first printerdevice that matches Printer.
    ' Full name is like "PDFCreator on Ne01:" for a English Windows and like
    ' "PDFCreator sur Ne01:" for French.
    ' Created: Frans Bus, 2015. See 
 
    Const HKEY_CURRENT_USER = &H80000001
    Dim regobj As Object
    Dim aTypes As Variant
    Dim aDevices As Variant
    Dim vDevice As Variant
    Dim sValue As String
    Dim v As Variant
    Dim sLocaleOn As String
     
    ' get locale "on" from current activeprinter
    v = Split(Application.ActivePrinter, Space(1))
    sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)
     
    ' connect to WMI registry provider on current machine with current user
    Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\.
ootdefault:StdRegProv")
     
    ' get the Devices from the registry
    regobj.EnumValues HKEY_CURRENT_USER, "SoftwareMicrosoftWindows NTCurrentVersionDevices", aDevices, aTypes
     
    ' find Printer and create full name
    For Each vDevice In aDevices
        ' get port of device
        regobj.GetStringValue HKEY_CURRENT_USER, "SoftwareMicrosoftWindows NTCurrentVersionDevices", vDevice, sValue
        ' select device
        If InStr(vDevice, Printer) > 0 Then
        'If Left(vDevice, Len(Printer)) = Printer Then ' match!
            ' create localized printername
            GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
            Exit Function
        End If
    Next
     
    ' at this point no match found
    GetPrinterFullName = vbNullString
 
End Function

'in un modulo
Option Explicit

'seleziona una stampante e la rende temporaneamente predefinita

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, i As Integer

    original_printer = ActivePrinter
    new_printer = EnumPrinter
    If new_printer = "" Then Exit Sub
    SetDefaultPrinter new_printer
    'ActiveSheet.PrintOut     '<<<<<< decommentare per stampare il foglio attivo
    
    i = InStrRev(original_printer, " ", InStrRev(original_printer, " ")) - 1
    SetDefaultPrinter Left(original_printer, i)
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 v As Variant
    Dim ChgP As Integer
    
    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 = InputBox(Msg)
    If Trim(v) = "" Then EnumPrinter = "": 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

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 v As Variant
    Dim ChgP As Integer
    
    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)
        v = gGetStr(PI_1(i).pName, 64)
        If InStr(LCase(v), "samsung") > 0 Then Exit For
    Next i
    If EnumPrinter = "" Then Exit Function
    EnumPrinter = gGetStr(PI_1(i).pName, 64)
End Function