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

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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

F
  • Locked
  • Question Question
Print Settings VS Macro Print Settings
Replies
1
Views
71
Peter_SSs
Peter_SSs
F
  • Question Question
Printing: File settings override code
Replies
1
Views
53
Flavien
F
4
  • Question Question
VBA to Print Labels but Issues Selecting Printer
Replies
1
Views
159
rpaulson
rpaulson
F
  • Question Question
How to open and print pdf file in a folder?
Replies
2
Views
169
Jaafar Tribak
Jaafar Tribak
F
  • Question Question
Printing error. Nothing is printed
Replies
2
Views
257
Flavien
F

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

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