VBA to print to a specific printer

L

leemcder

New Member
Joined
Feb 26, 2018
Messages
42
Hi, I am using the code below to print documents, I want to be able to force it to print to a specific printer. Several people use this and we are all set up to different default printers so I want it to print out at a specific printer without having the change our printers. Can this be done and can anyone please tell me what I need to add to the code? Many thanks

Code: 
Sub PrintFiles()
    Dim oFSO As Object
    Dim lngLastRow As Long
    Dim lngIndex As Long
    Dim strFname As String
    Dim xlSheet As Worksheet
    Dim xlWB As Workbook
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set xlSheet = ActiveSheet
    
    With xlSheet
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngIndex = 1 To lngLastRow
            strFname = .Range("A" & lngIndex)
            If oFSO.FileExists(strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
                Set xlWB = Workbooks.Open(strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
                xlWB.Sheets(1).PageSetup.Zoom = 95
                xlWB.Sheets(1).PrintOut From:=1, To:=1
                ThisWorkbook.Sheets(2).PrintOut From:=1, To:=1
                xlWB.Close savechanges:=False
            Else
                .Range("A" & lngIndex).Interior.Color = &H80FFFF
            End If
        Next lngIndex
    End With
lbl_Exit:
    Set oFSO = Nothing
    Set xlSheet = Nothing
    Set xlWB = Nothing
    Exit Sub
    
End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
you could try this

Dim strCurrentPrinter As String
strCurrentPrinter = Application.ActivePrinter
 
Upvote 0
Thanks, sorry I am new to VBA, how would it know from this which printer I want it to print to? and where do I insert this? many thanks

Dryver14 said:
you could try this

Dim strCurrentPrinter As String
strCurrentPrinter = Application.ActivePrinter
Click to expand...
 
Upvote 0
OK this wont work reading your post again,

do you know enough to look at the immediate window, if so with the printer set to where you want them all to print to

run the following, and copy and paste the result in your response here

Code: 
Sub getprinter()
 
    Dim strCurrentPrinter As String
    
    strCurrentPrinter = Application.ActivePrinter


    Debug.Print strCurrentPrinter


 End Sub
 
Upvote 0
Okay, this is what comes up on the immediate window (below) is this what you need?

\\ts-ps01\GHNP0006 on Ne03:

Dryver14 said:
OK this wont work reading your post again,

do you know enough to look at the immediate window, if so with the printer set to where you want them all to print to

run the following, and copy and paste the result in your response here

Code: 
Sub getprinter()
 
    Dim strCurrentPrinter As String
    
    strCurrentPrinter = Application.ActivePrinter


    Debug.Print strCurrentPrinter


 End Sub
Click to expand...
 
Upvote 0
This should change the printer to print this then return to normal printer. People have to have this printer set as an option on their printer list

Code: 
Sub PrintFiles()


    Dim oFSO As Object
    Dim lngLastRow As Long
    Dim lngIndex As Long
    Dim strFname As String
    Dim xlSheet As Worksheet
    Dim xlWB As Workbook
    Dim Printer As String
        Printer = Application.ActivePrinter
        Application.ActivePrinter = "ts-ps01\GHNP0006 on Ne03:"




    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set xlSheet = ActiveSheet
    
    With xlSheet
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngIndex = 1 To lngLastRow
            strFname = .Range("A" & lngIndex)
            If oFSO.FileExists(strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
                Set xlWB = Workbooks.Open(strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
                xlWB.Sheets(1).PageSetup.Zoom = 95
                xlWB.Sheets(1).PrintOut From:=1, To:=1
                ThisWorkbook.Sheets(2).PrintOut From:=1, To:=1
                Application.ActivePrinter = Printer
                xlWB.Close savechanges:=False
            Else
                .Range("A" & lngIndex).Interior.Color = &H80FFFF
            End If
        Next lngIndex
    End With
lbl_Exit:
    Set oFSO = Nothing
    Set xlSheet = Nothing
    Set xlWB = Nothing
    Exit Sub
    
End Sub
 
Upvote 0
Thanks, this works for the first document but the rest print out from the default printer, any idea why?

Dryver14 said:
This should change the printer to print this then return to normal printer. People have to have this printer set as an option on their printer list

Code: 
Sub PrintFiles()


    Dim oFSO As Object
    Dim lngLastRow As Long
    Dim lngIndex As Long
    Dim strFname As String
    Dim xlSheet As Worksheet
    Dim xlWB As Workbook
    Dim Printer As String
        Printer = Application.ActivePrinter
        Application.ActivePrinter = "ts-ps01\GHNP0006 on Ne03:"




    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set xlSheet = ActiveSheet
    
    With xlSheet
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngIndex = 1 To lngLastRow
            strFname = .Range("A" & lngIndex)
            If oFSO.FileExists(strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
                Set xlWB = Workbooks.Open(strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
                xlWB.Sheets(1).PageSetup.Zoom = 95
                xlWB.Sheets(1).PrintOut From:=1, To:=1
                ThisWorkbook.Sheets(2).PrintOut From:=1, To:=1
                Application.ActivePrinter = Printer
                xlWB.Close savechanges:=False
            Else
                .Range("A" & lngIndex).Interior.Color = &H80FFFF
            End If
        Next lngIndex
    End With
lbl_Exit:
    Set oFSO = Nothing
    Set xlSheet = Nothing
    Set xlWB = Nothing
    Exit Sub
    
End Sub
Click to expand...
 
Upvote 0
Yes, I changed the default printer too early in the procedure, try this

Code: 
Sub PrintFiles()




    Dim oFSO As Object
    Dim lngLastRow As Long
    Dim lngIndex As Long
    Dim strFname As String
    Dim xlSheet As Worksheet
    Dim xlWB As Workbook
    Dim Printer As String
        Printer = Application.ActivePrinter
        Application.ActivePrinter = "ts-ps01\GHNP0006 on Ne03:"








    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set xlSheet = ActiveSheet
    
    With xlSheet
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngIndex = 1 To lngLastRow
            strFname = .Range("A" & lngIndex)
            If oFSO.FileExists(strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
                Set xlWB = Workbooks.Open(strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
                xlWB.Sheets(1).PageSetup.Zoom = 95
                xlWB.Sheets(1).PrintOut From:=1, To:=1
                ThisWorkbook.Sheets(2).PrintOut From:=1, To:=1
                xlWB.Close savechanges:=False
            Else
                .Range("A" & lngIndex).Interior.Color = &H80FFFF
            End If
        Next lngIndex
    End With
            Application.ActivePrinter = Printer
lbl_Exit:
    Set oFSO = Nothing
    Set xlSheet = Nothing
    Set xlWB = Nothing
    Exit Sub
    
End Sub
 
Upvote 0
Brilliant! That works perfectly now. Thank you for your help, it is much appreciated!

Dryver14 said:
Yes, I changed the default printer too early in the procedure, try this

Code: 
Sub PrintFiles()




    Dim oFSO As Object
    Dim lngLastRow As Long
    Dim lngIndex As Long
    Dim strFname As String
    Dim xlSheet As Worksheet
    Dim xlWB As Workbook
    Dim Printer As String
        Printer = Application.ActivePrinter
        Application.ActivePrinter = "ts-ps01\GHNP0006 on Ne03:"








    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set xlSheet = ActiveSheet
    
    With xlSheet
        lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngIndex = 1 To lngLastRow
            strFname = .Range("A" & lngIndex)
            If oFSO.FileExists(strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname) Then
                'If oFSO.FileExists("C:\Path" & strFname & ".xls") Then
                Set xlWB = Workbooks.Open(strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname)
                'Set xlWB = Workbooks.Open("C:\Path" & strFname& ".xls")
                xlWB.Sheets(1).PageSetup.Zoom = 95
                xlWB.Sheets(1).PrintOut From:=1, To:=1
                ThisWorkbook.Sheets(2).PrintOut From:=1, To:=1
                xlWB.Close savechanges:=False
            Else
                .Range("A" & lngIndex).Interior.Color = &H80FFFF
            End If
        Next lngIndex
    End With
            Application.ActivePrinter = Printer
lbl_Exit:
    Set oFSO = Nothing
    Set xlSheet = Nothing
    Set xlWB = Nothing
    Exit Sub
    
End Sub
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Print resultValue from VBA script
Replies
5
Views
454
georgeeye
G
V
  • Question
Excel VBA - How to modify my code to include a command that prints data to PDF
Replies
1
Views
109
VanGirl
V
L
  • Solved
Fixing VBA code
Replies
3
Views
493
Joe4
Joe4
2
  • Question
Print PDF with page breaks VBA
Replies
2
Views
2K
2022
2
O
  • Solved
Looping files in folders, cannot set wb object to files to open
Replies
3
Views
419
smozgur
smozgur

Forum statistics

Threads
1,215,340
Messages
6,124,386
Members
449,155
Latest member
ravioli44

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top