Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 843
  • Last Modified:

Microsoft Excel 2007 - Change Default Printer

I have built a macro using Excel 2007 that will print all files located in a specified folder.  The macro prints these files in alphabetical order.  I need all of these documents to be sent to the color printer which is not the default printer.  I came across the following code to change the printer in excel:

Application.Dialogs(xlDialogPrinterSetup).Show

However this does not achieve what I am looking for because I am not printing exclusively excel workbooks.  I am also printing PDF files and Word Documents.  I need the macro to change the system default printer so the non-excel files go to the same printer as well.  I found the following article which achieves my goal in Visual Basic, but I need to do this with VBA.

http://support.microsoft.com/default.aspx?scid=http://support.microsoft.com:80/support/kb/articles/Q266/7/67.ASP&NoWebContent=1


0
chrissmith18
Asked:
chrissmith18
  • 3
1 Solution
 
dlmilleCommented:
I went at it a bit differently and found some API sources I'm now testing.

Most of the code enumerates printers and such, and I have code to set the default system printer...

Let me pull this together in usable form.

Here are my sources for your interest:
http://www.xtremevbtalk.com/showthread.php?t=258994
http://support.microsoft.com/kb/q166008/

I've tested all but setting the default printer.

What I can do is provide some code that lists the printers, allows you to identfy one, and set a defined name to that printer.

Then, another routine that if called, sets the printer based on that range name.

Does this make sense?  I'm trying to anticipate the work process and sounds like your macro would prompt for a folder to print from, could then prompt for the printer to use, then does its magic - correct?

Dave
0
 
dlmilleCommented:
This is the code you put in VBA module at the top to set the default printer:

Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" _
                                                        (ByVal pszPrinter As String) As Long

call it like:

SetDefaultPrinter("full name of the printer")
0
 
dlmilleCommented:
Ok - here's a little app that prompts for selection of new default printer, makes the change with a stub for continued processing.

Code:
USERFORM:

Private Sub CommandButton1_Click()

    set_DefaultPrinter (ListBox1.Value)
    
End Sub

Private Sub CommandButton2_Click()
    Unload UserForm1
    Call continueProcessing
End Sub


Private Sub UserForm_Initialize()
Dim i As Integer, currDefaultPrinter As String

    currDefaultPrinter = Get_DefaultPrinterName
    
    Call EnumeratePrinters4 'modified to load dynamic array, PrinterNames()
    
    For i = 0 To UBound(PrinterNames)
        ListBox1.AddItem PrinterNames(i)
        Debug.Print currDefaultPrinter, PrinterNames(i)
        If InStr(currDefaultPrinter, PrinterNames(i)) <> 0 Then
            ListBox1.Selected(i) = True
        End If
    Next i
    
End Sub


MODULE:

Sub enumPrintersSetDefault_UI()

    Load UserForm1
    UserForm1.Show
    
End Sub
Sub continueProcessing()
    MsgBox "Ok - System Printer now set to" & Get_DefaultPrinterName & ", code goes here for continued processing", vbOKOnly
End Sub

Open in new window


The code uses the Enumerate code from:  Sources:http://support.microsoft.com/kb/q166008/, where I loaded a public dynamic array of PrinterNames in the middle of the Enumerate4() routine
'Adapted from Sources:http://support.microsoft.com/kb/q166008/

Option Explicit

Public PrinterNames() As String

  Const PRINTER_ENUM_CONNECTIONS = &H4
  Const PRINTER_ENUM_LOCAL = &H2

  Type PRINTER_INFO_1
     flags As Long
     pDescription As String
     pName As String
     PComment As String
  End Type

  Type PRINTER_INFO_4
     pPrinterName As String
     pServerName As String
     Attributes As Long
  End Type

  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
  Declare Function PtrToStr Lib "Kernel32" Alias "lstrcpyA" _
     (ByVal RetVal As String, ByVal Ptr As Long) As Long
  Declare Function StrLen Lib "Kernel32" Alias "lstrlenA" _
     (ByVal Ptr As Long) As Long


Sub EnumeratePrinters1()
Dim Success As Boolean, cbRequired As Long, cbBuffer As Long
Dim Buffer() As Long, nEntries As Long
Dim i As Long, PFlags As Long, PDesc As String, pName As String
Dim PComment As String, Temp As Long
   cbBuffer = 3072
   ReDim Buffer((cbBuffer \ 4) - 1) As Long
   Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                         PRINTER_ENUM_LOCAL, _
                         vbNullString, _
                         1, _
                         Buffer(0), _
                         cbBuffer, _
                         cbRequired, _
                         nEntries)
   If Success Then
      If cbRequired > cbBuffer Then
         cbBuffer = cbRequired
         Debug.Print "Buffer too small.  Trying again with " & _
                  cbBuffer & " bytes."
         ReDim Buffer(cbBuffer \ 4) As Long
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                             PRINTER_ENUM_LOCAL, _
                             vbNullString, _
                             1, _
                             Buffer(0), _
                             cbBuffer, _
                             cbRequired, _
                             nEntries)
         If Not Success Then
            Debug.Print "Error enumerating printers."
            Exit Sub
         End If
      End If
   Debug.Print "There are " & nEntries & _
                " local and connected printers."
   For i = 0 To nEntries - 1
      PFlags = Buffer(4 * i)
      PDesc = Space$(StrLen(Buffer(i * 4 + 1)))
      Temp = PtrToStr(PDesc, Buffer(i * 4 + 1))
      pName = Space$(StrLen(Buffer(i * 4 + 2)))
      Temp = PtrToStr(pName, Buffer(i * 4 + 2))
      PComment = Space$(StrLen(Buffer(i * 4 + 2)))
      Temp = PtrToStr(PComment, Buffer(i * 4 + 2))
      Debug.Print PFlags, PDesc, pName, PComment
   Next i
   Else
      Debug.Print "Error enumerating printers."
   End If
End Sub

Sub EnumeratePrinters4()
Dim Success As Boolean, cbRequired As Long, cbBuffer As Long
Dim Buffer() As Long, nEntries As Long
Dim i As Long, pName As String, SName As String
Dim Attrib As Long, Temp As Long
   cbBuffer = 3072
   ReDim Buffer((cbBuffer \ 4) - 1) As Long
   Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                         PRINTER_ENUM_LOCAL, _
                         vbNullString, _
                         4, _
                         Buffer(0), _
                         cbBuffer, _
                         cbRequired, _
                         nEntries)
   If Success Then
      If cbRequired > cbBuffer Then
         cbBuffer = cbRequired
         Debug.Print "Buffer too small.  Trying again with " & _
                  cbBuffer & " bytes."
         ReDim Buffer(cbBuffer \ 4) As Long
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                             PRINTER_ENUM_LOCAL, _
                             vbNullString, _
                             4, _
                             Buffer(0), _
                             cbBuffer, _
                             cbRequired, _
                             nEntries)
         If Not Success Then
            Debug.Print "Error enumerating printers."
            Exit Sub
         End If
      End If
      Debug.Print "There are " & nEntries & _
                " local and connected printers."
      For i = 0 To nEntries - 1
      pName = Space$(StrLen(Buffer(i * 3)))
      Temp = PtrToStr(pName, Buffer(i * 3))
      SName = Space$(StrLen(Buffer(i * 3 + 1)))
      Temp = PtrToStr(SName, Buffer(i * 3 + 1))
      Attrib = Buffer(i * 3 + 2)
      Debug.Print "Printer: " & pName, "Server: " & SName, _
                  "Attributes: " & Hex$(Attrib)
                  
    'modified for E-E Solution by DLMILLE
    ReDim Preserve PrinterNames(i)
    PrinterNames(i) = pName
      Next i
   Else
      Debug.Print "Error enumerating printers."
   End If
End Sub

Open in new window

It also uses the Get/Set Printer code from:Sources: http://www.xtremevbtalk.com/showthread.php?t=258994 
 
'Adapted from Sources: http://www.xtremevbtalk.com/showthread.php?t=258994
Option Explicit

Private Declare Function GetProfileString Lib "kernel32.dll" Alias "GetProfileStringA" _
                                                        (ByVal lpAppName As String, _
                                                        ByVal lpKeyName As String, _
                                                        ByVal lpDefault As String, _
                                                        ByVal lpReturnedString As String, _
                                                        ByVal nSize As Long) As Long

Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" _
                                                        (ByVal pszPrinter As String) As Long
Function Get_DefaultPrinterName() As String
Const BUFFSIZE As Long = 254

Dim strBuffer As String * BUFFSIZE
Dim lngRetVal As Long

    lngRetVal = GetProfileString("windows", "device", ",,,", strBuffer, BUFFSIZE)
    Get_DefaultPrinterName = Left(strBuffer, InStr(strBuffer, ":"))
    
End Function

Sub set_DefaultPrinter(pName As String)
    SetDefaultPrinter (pName)
End Sub

Open in new window


See attached file,

Enjoy!

Dave
PrinterDefaults-r1.xls
0
 
chrissmith18Author Commented:
This works perfectly,  Thank you!!
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now