Word 2010 VBA 选择打印机而不更改系统默认打印机

Question

在 Word 2010 中，我正在尝试创建一个宏，将当前打印机设置为我们网络上的特定颜色打印机，而不是将该打印机设置为用户的系统默认打印机。我从网上找到的示例中整理了一些代码。一切正常，除了 SetColorPrinterEast Sub 更改了用户的系统默认打印机，这是我不想要的。我怀疑该 sub 中的 DoNotSetAsSysDefault 没有按预期工作，但我不知道该怎么做。请参阅代码中的 cmets 以获得进一步的解释。任何想法将不胜感激。提前谢谢！！！

'I found the code block below on the web. I don't understand it, but
'it seems to work properly with the "SetDefaultPrinter"
'Sub below to get the system default printer.    
Public Declare Function GetProfileString Lib "kernel32" _
        Alias "GetProfileStringA" _
        (ByVal lpAppName As String, _
         ByVal lpKeyName As String, _
         ByVal lpDefault As String, _
         ByVal lpReturnedString As String, _
         ByVal nSize As Long) As Long

' This code successfully sets the document to print from
' the system default printer.
Public Sub SetDefaultPrinter()

    Dim strReturn As String
    Dim intReturn As Integer
    strReturn = Space(255)
    intReturn = GetProfileString("Windows", ByVal "device", "", _
    strReturn, Len(strReturn))
    If intReturn Then
        strReturn = UCase(Left(strReturn, InStr(strReturn, ",") - 1))
    End If

    With Dialogs(wdDialogFilePrintSetup)
        .Printer = strReturn
        .DoNotSetAsSysDefault = True
        .Execute
    End With

End Sub

' This code correctly sets the printer to a specific color printer
' on our network. The problem is that it makes that printer
' the user's system default printer. I would think that the
' .DoNotSetAsSysDefault = True line would solve this problem
' but still this sub changes the user's system default printer.

Public Sub SetColorPrinterEast()

    With Dialogs(wdDialogFilePrintSetup)
        .Printer = "\\[*NETWORK PATH*]\Color Printer East"
        .DoNotSetAsSysDefault = True
        .Execute
    End With

End Sub

Answer 1

几年前我也遇到过同样的问题，通过将当前默认打印存储在一个变量中，将默认打印机更改为我需要的打印机，打印，然后将默认打印机更改回用户原始默认设置来解决它。

这是为 Word 2003 设计和编写的，但在 Word 2010 中仍然有效。

这是我使用的具体代码：

'Define Printer to add and printer to delete
Const PrintPath = "\\prn001l0003\Colour04"
Const PrintDeletePath = "\\prn001l0003\Colour02"


' Used to see what printers are set up on the user, and to set a new network printer
Public Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, _
        ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Public Declare Function StrLen Lib "kernel32" Alias "lstrlenA" (ByVal Ptr As Long) As Long
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2



Public Sub PrintLetter(ByRef LetterBrochures() As String)
'Print the document

    Dim STDprinter As String

    On Error Resume Next

    Call CheckPrinterLoaded     ' Get users loaded printers, remove any old printers used here,
                                ' and add printer I want to users printers

    STDprinter = Application.ActivePrinter  ' store the current default printer
    Application.ActivePrinter = PrintPath ' change default printer to want I want

    On Error GoTo printLetterError

    Application.DisplayAlerts = wdAlertsNone    ' prevent Word showing any alert/warnings etc

    With ActiveDocument     '  first page is letterhead from tray 2, all others from tray 1, print
        .PageSetup.FirstPageTray = 3 ' 3 = Tray 2 on MFLaser
        .PageSetup.OtherPagesTray = 1  ' 1 = Tray 1 on MFLaser
        .PrintOut Background:=False
    End With
    Application.DisplayAlerts = wdAlertsAll     ' enable Word alets/warning etc
    Application.ActivePrinter = STDprinter 'change back users default printer

    Exit Sub
printLetterError:
    MsgBox "Error printing letter" & vbCrLf & Err.Number & vbCrLf & Err.Description, vbCritical, "Error"
    ActiveDocument.Close False
    End
End Sub


Public Function CheckPrinterLoaded()
'get users printers
'look for and delete defined printer, PrintDeletePath
'add printer I want to users printers, PrintPath

    Dim StrPrinters As Variant, x As Long
    Dim StrSetPrinter As String
    Dim objNetwork
    Set objNetwork = CreateObject("WScript.Network")

    StrPrinters = ListPrinters

    'Fist check whether the array is filled with anything, by calling another function, IsBounded.
    If IsBounded(StrPrinters) Then
        For x = LBound(StrPrinters) To UBound(StrPrinters)
            If StrPrinters(x) = PrintDeletePath Then
                objNetwork.RemovePrinterConnection PrintDeletePath
            End If
        Next x
        objNetwork.AddWindowsPrinterConnection PrintPath
    Else
        MsgBox "No printers found"
    End If

End Function


Private Function ListPrinters() As Variant
    Dim bSuccess As Boolean
    Dim iBufferRequired As Long
    Dim iBufferSize As Long
    Dim iBuffer() As Long
    Dim iEntries As Long
    Dim iIndex As Long
    Dim strPrinterName As String
    Dim iDummy As Long
    Dim iDriverBuffer() As Long
    Dim StrPrinters() As String

    iBufferSize = 3072

    ReDim iBuffer((iBufferSize \ 4) - 1) As Long

    'EnumPrinters will return a value False if the buffer is not big enough
    bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, 1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)

    If Not bSuccess Then
        If iBufferRequired > iBufferSize Then
            iBufferSize = iBufferRequired
            Debug.Print "iBuffer too small. Trying again with "; iBufferSize & " bytes."
            ReDim iBuffer(iBufferSize \ 4) As Long
        End If
        'Try again with new buffer
        bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, 1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
    End If

    If Not bSuccess Then
        'Enumprinters returned False
        MsgBox "Error enumerating printers."
        Exit Function
    Else
        'Enumprinters returned True, use found printers to fill the array
        ReDim StrPrinters(iEntries - 1)
        For iIndex = 0 To iEntries - 1
            'Get the printername
            strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
            iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
            StrPrinters(iIndex) = strPrinterName
        Next iIndex
    End If

    ListPrinters = StrPrinters

End Function


Private Function IsBounded(vArray As Variant) As Boolean
    'If the variant passed to this function is an array, the function will return True; otherwise it will return False
    On Error Resume Next
    IsBounded = IsNumeric(UBound(vArray))

End Function