VB code to set an excel document to only print to a designated network printer

[piddjo01]

Is there any possible way to have an excel document (through VB) only print to a certain printer on the network. I would like it so it just does it automatically and a person would not have to choose between printers on the network.

 

[Gary McMaster]

The following will set the active printer:

Application.ActivePrinter = "Printer Name in Quotes"

You can find out the name of the active printer by actually doing a test print to the device and then run the following code:

MsgBox Application.ActivePrinter
Debug.Print Application.ActivePrinter

I have some code (written by someone else) that will return the name of all the printers available to the system. Give a yell if you're interested in a copy.

Hope this helps.

Gary

 

[piddjo01]

That code might be helpful because I have a lot of different printers on my network and some of them have wierd names.

 

[Gary McMaster]

Here's a copy of the code I mentioned.

Gary

In a standard module (run "Test" to list printers to debug window):

Option Explicit


'Written by: Astrid Zeelenberg, http://word.mvps.org/
Const PRINTER_ENUM_CONNECTIONS = &H4
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 Long, ByVal cdBuf As Long, pcbNeeded As Long, _
        pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
        (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
       (ByVal Ptr As Long) As Long


Public Function ListPrinters() As Variant

'Written by: Astrid Zeelenberg, http://word.mvps.org/

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
   

Sub Test()

'Written by: Astrid Zeelenberg, http://word.mvps.org/
'You could call the function as follows:

Dim StrPrinters As Variant, x As Long

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)
        Debug.Print StrPrinters(x)
    Next x
Else
    Debug.Print "No printers found"
End If

End Sub


Public Function IsBounded(vArray As Variant) As Boolean

'Written by: Astrid Zeelenberg, http://word.mvps.org/
'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

Optional, in a command button on the worksheet (List printers in active worksheet column A):

Private Sub CommandButton1_Click()

Dim StrPrinters As Variant, x As Long

StrPrinters = ListPrinters

ThisWorkbook.ActiveSheet.Columns(1).Clear

'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)
        ThisWorkbook.ActiveSheet.Cells(x + 1, 1).Value = StrPrinters(x)
        'Debug.Print StrPrinters(x)
    Next x
Else
    Debug.Print "No printers found"
End If

ThisWorkbook.ActiveSheet.Columns.AutoFit

End Sub

 

[piddjo01]

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim oCell As Range
Dim NoBlanks As Range
Set NoBlanks = ActiveSheet.Range("B7, D7, F7, H7, J7, L7, B9, D9, F9, H9, J9, L9, B11, D11, F11, H11, J11, L11, B13, D13, F13, H13, J13, L13, B15, D15, F15, H15, J15, L15, B17, D17, F17, H17, J17, L17") 'List all cells
For Each oCell In NoBlanks
If oCell.Value = "" Then
Cancel = True
MsgBox "Not all required cells have been filled", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
Next
End Sub
Application.ActivePrinter = "\\sleepdc001.norwoodaustin.com\SLEE_RCV_CPY"


If I already have the above code in place, is this the location where I would put the Active printer code or do I have to have something else with it or do I have to place it within the previously written code?

 

[Gary McMaster]

Try putting it just before the "End Sub"

Private Sub Workbook_BeforePrint(Cancel As Boolean)

Dim oCell As Range
Dim NoBlanks As Range
Set NoBlanks = ActiveSheet.Range("B7, D7, F7, H7, J7, L7, B9, D9, F9, H9, J9, L9, B11, D11, F11, H11, J11, L11, B13, D13, F13, H13, J13, L13, B15, D15, F15, H15, J15, L15, B17, D17, F17, H17, J17, L17") 'List all cells
For Each oCell In NoBlanks
If oCell.Value = "" Then
Cancel = True
MsgBox "Not all required cells have been filled", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
Next

[B]Application.ActivePrinter = "\\sleepdc001.norwoodaustin.com\SLEE_RCV_CPY"[/B]

End Sub

 

[Gary McMaster]

The workbook open event might be a better place to put it in that it will only run once instead of every time print is selected. If you only print once every time you open the workbook then it probably doesn't even matter. IMO it doesn't matter if you set it multiple times to the same value. I would rather have all the "related" code in the same procedure than worry about microseconds of wasted / redundant execution time.

Private Sub Workbook_Open()

Application.ActivePrinter = "\\sleepdc001.norwoodaustin.com\SLEE_RCV_CPY"

End Sub

 

[piddjo01]

Thanks, it worked great!