Specify Printer when Printing Files

问题

I have a macro that prints all files within a specific folder but each time it opens a file it asks which printer to print from.

I want to enter the printer name or IP instead of asking the user or using the default printer.

Sub PrintDespatches()
Dim wb As Workbook, ws As Worksheet
Dim FileName As String, path As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet

path = "Z:\Customer Operations\2021\Despatches\*.csv"

FileName = Dir(path, vbNormal)
Do Until FileName = ""
    Application.DisplayAlerts = False
    Application.Dialogs(xlDialogPrinterSetup).Show
    Workbooks.Open Left(path, Len(path) - 5) & FileName
    Columns("A:H").AutoFit
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        ws.PrintOut
    Next
    wb.Close
    FileName = Dir()
Loop
End Sub

I tried replacing Application.Dialogs(xlDialogPrinterSetup).Show with mynetwork.setdefaultprinter "Your Printer Name".

回答1:

Please, try using:

Application.ActivePrinter = "Microsoft Print to PDF on Ne02:" 'use here your printer

But it is not enough to write a string as you can see the printer name in 'Printers & Scanners'.

A. You firstly need to enumerate all installed printers and use the exact string, including the port, too.

B. Or, simpler, you can do that by printing something using the printers Setup dialog, choosing the printer you need and getting it using a simple code line:

Debug.Print Application.ActivePrinter

Then, use the returned printer name...

In order to return all installed printers in the way Excel is able to use their names, it is a little more complicated. But, if you want/need it, try the next approach, please:

Copy the next API function declarations and constants on top of a standard module (in the declarations area):

Option Explicit

Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

#If VBA7 Then
    #If Win64 Then
        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 RegEnumValue Lib "advapi32.dll" Alias _
           "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, _
           ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, _
                                     lpType As Long, lpData As Byte, lpcbData As Long) As Long
                                     
        Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
        Declare PtrSafe Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" _
                (ByVal lpMachineName As String, ByVal hKey As LongPtr, phkResult As LongPtr) As Long
    #Else
        Private Declare Function RegOpenKeyEx Lib "advapi32" _
            Alias "RegOpenKeyExA" ( _
            ByVal hKey As Long, _
            ByVal lpSubKey As String, _
            ByVal ulOptions As Long, _
            ByVal samDesired As Long, _
            phkResult As Long) As Long
        
        Private Declare Function RegEnumValue Lib "advapi32.dll" _
            Alias "RegEnumValueA" ( _
            ByVal hKey As Long, _
            ByVal dwIndex As Long, _
            ByVal lpValueName As String, _
            lpcbValueName As Long, _
            ByVal lpReserved As Long, _
            lpType As Long, _
            lpData As Byte, _
            lpcbData As Long) As Long
        
        Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
            ByVal hKey As Long) As Long
    #End If
#Else
    Private Declare Function RegOpenKeyEx Lib "advapi32" _
        Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
        
    Private Declare Function RegEnumValue Lib "advapi32.dll" _
        Alias "RegEnumValueA" ( _
        ByVal hKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpValueName As String, _
        lpcbValueName As Long, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Byte, _
        lpcbData As Long) As Long
        
    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal HKey As Long) As Long#End If
#End If

Copy the next function in the same module:

    

Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long         ' index into Printers()
#If Win64 Then
    Dim hKey As LongPtr  ' registry key handle
#Else
    Dim hKey As Long     ' registry key handle
#End If
    
Dim res As Long          ' result of API calls
Dim Ndx As Long          ' index for RegEnumValue
Dim ValueName As String  ' name of each value in the printer key
Dim ValueNameLen As Long    ' length of ValueName
Dim DataType As Long        ' registry value data type
Dim ValueValue() As Byte    ' byte array of registry value value
Dim ValueValueS As String   ' ValueValue converted to String
Dim CommaPos As Long        ' position of comma character in ValueValue
Dim ColonPos As Long        ' position of colon character in ValueValue
Dim M As Long               ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
                            KEY_QUERY_VALUE, hKey)
' start enumeration loop of printers
res = RegEnumValue(hKey, Ndx, ValueName, _
    ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until res = ERROR_NO_MORE_ITEMS
    M = InStr(1, ValueName, Chr(0))
    If M > 1 Then
        ' clean up the ValueName
        ValueName = left(ValueName, M - 1)
    End If
    ' find position of a comma and colon in the port name
    CommaPos = InStr(1, ValueValue, ",")
    ColonPos = InStr(1, ValueValue, ":")
    ' ValueValue byte array to ValueValueS string
    On Error Resume Next
    ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
    On Error GoTo 0
    ' next slot in Printers
    PNdx = PNdx + 1
    Printers(PNdx) = ValueName & " on " & ValueValueS
    ' reset some variables
    ValueName = String(255, Chr(0))
    ValueNameLen = 255
    ReDim ValueValue(0 To 999)
    ValueValueS = vbNullString
    ' tell RegEnumValue to get the next registry value
    Ndx = Ndx + 1
    ' get the next printer
    res = RegEnumValue(hKey, Ndx, ValueName, ValueNameLen, _
        0&, DataType, ValueValue(0), 1000)
    ' test for error
    If (res <> 0) And (res <> ERROR_MORE_DATA) Then
        Exit Do
    End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
res = RegCloseKey(hKey)
' Return the result array
GetPrinterFullNames = Printers
End Function

You need to use the above code once, in order to receive the installed printers name (port included) as Excel needs them. Copy the next testing Sub:

Sub TestEnumPrinters()
    Dim Printers() As String, n As Long, S As String
    Printers = GetPrinterFullNames()
    For n = LBound(Printers) To UBound(Printers)
        Debug.Print Printers(n) ', left(Printers(n), InStr(Printers(n), " on "))
    Next n
End Sub

Now use the printer name as it is returned and set the printer to be used:

Application.ActivePrinter = "My printer ... on Ne0x:"

来源：https://stackoverflow.com/questions/63790613/specify-printer-when-printing-files

标签

excel

vba

printing