'---------------------------------------------------------------------------------------
' Module : modToolbar
' DateTime : 26/03/2015
' Author : Keiron Trott
' Purpose : This modules contains procedures for printing which will be added to the ribbon
' Modified : Keiron Trott
' Purpose : Updates for office 2007-2010. Added printer choosing code from Microsoft
'---------------------------------------------------------------------------------------
 
Option Explicit
Option Compare Text
Private Const csModuleName As String = "modToolbar"
 
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''
'Printer util functions here from microsoft
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''
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
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
 
'You could call the function as follows:
 
' --------------------------------------------------------------------------------
Sub Test()
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
'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
 
Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
' returns the full network printer name
' returns an empty string if the printer is not found
' e.g. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
' might return "HP LaserJet 8100 Series PCL on Ne04:"
Dim i As Long
 
' if not found let it pass backstring and error
GetFullNetworkPrinterName = strNetworkPrinterName
Dim StrPrinters As Variant
' Dim i As Long
Dim sPrinter As String
Dim sPrinterListed As String
StrPrinters = ListPrinters
sPrinter = ActivePrinter
If IsBounded(StrPrinters) Then
  For i = LBound(StrPrinters) To UBound(StrPrinters)
    sPrinterListed = StrPrinters(i)
    If InStr(UCase(StrPrinters(i)), UCase(strNetworkPrinterName)) Then
      ' ActivePrinter = StrPrinters(i)
      ' Only choose if Network name ends with strNetworkPrinterName
      Dim EndName As String
      EndName = Mid(sPrinterListed, InStrRev(sPrinterListed, "\") + 1)
 
      ' MsgBox EndName
      If UCase(EndName) = UCase(strNetworkPrinterName) Then
        i = UBound(StrPrinters) 'break for loop
        GetFullNetworkPrinterName = sPrinterListed
      End If
    End If
  Next i
  ' MsgBox "Printers available"
End If
End Function
 
Function GetFullNetworkPrinterNameExclude(strNetworkPrinterName As String, strExcludePrinterName As String) As String
' returns the full network printer name
' returns an empty string if the printer is not found
' e.g. GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL")
' might return "HP LaserJet 8100 Series PCL on Ne04:"
Dim i As Long
 
' if not found let it pass backstring and error
GetFullNetworkPrinterNameExclude = strNetworkPrinterName
Dim StrPrinters As Variant
' Dim i As Long
Dim sPrinter As String
Dim sPrinterListed As String
StrPrinters = ListPrinters
sPrinter = ActivePrinter
If IsBounded(StrPrinters) Then
  For i = LBound(StrPrinters) To UBound(StrPrinters)
    sPrinterListed = StrPrinters(i)
    If InStr(UCase(StrPrinters(i)), UCase(strNetworkPrinterName)) And Not (InStr(UCase(StrPrinters(i)), UCase(strExcludePrinterName))) Then
      ' ActivePrinter = StrPrinters(i)
      GetFullNetworkPrinterNameExclude = sPrinterListed
      i = UBound(StrPrinters) 'break for loop
    End If
  Next i
  ' MsgBox "Printers available"
End If
 
End Function
 
'--------------------------------------------------
' Toolbar macros
'--------------------------------------------------
Public Sub PrintOfficeCopy()
' Prints the whole document
If Documents.Count = 0 Then Exit Sub
 
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
ActivePrinter = GetFullNetworkPrinterName("Mono Duplex")
 
'PDF for testing
''ActivePrinter = "CutePDF Writer"
 
'Set up trays for file copy
'
Dim oSct As Section
Dim iSection As Integer
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterDefaultBin
    .OtherPagesTray = wdPrinterDefaultBin
  End With
  iSection = iSection + 1
  '
Next oSct
 
' print Office copy
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
  wdPrintDocumentContent, Copies:=1, Pages:="", PageType:=wdPrintAllPages, _
  ManualDuplexPrint:=False, Collate:=True
 
'switch printer back
ActivePrinter = sCurrentPrinter
 
End Sub
 
Public Sub PrintClientCopy()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  If iSection = 1 Then
    With ActiveDocument.Sections(iSection).PageSetup
      .FirstPageTray = wdPrinterUpperBin
      .OtherPagesTray = wdPrinterMiddleBin
    End With
  Else
    With ActiveDocument.Sections(iSection).PageSetup
      .FirstPageTray = wdPrinterMiddleBin
      .OtherPagesTray = wdPrinterMiddleBin
    End With
  End If
 
  iSection = iSection + 1
  '
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
''Now print office copy
PrintOfficeCopy
 
End Sub
 
Public Sub PrintDocumentCopy()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterMiddleBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
  iSection = iSection + 1
'
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
''Now print office copy
PrintOfficeCopy
 
End Sub
Public Sub PrintDocumentOnly()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterMiddleBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
 
  iSection = iSection + 1
'
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
End Sub
 
Public Sub PrintLetterheadOnly()
' Prints the page containing the cursor of the current document
If Documents.Count = 0 Then Exit Sub
 
' set to good copy
Dim sDraft As String
sDraft = Options.PrintDraft
Options.PrintDraft = False
 
'----------------
' Select whole document
' Selection.WholeStory
'Get current printer
Dim sCurrentPrinter As String
sCurrentPrinter = ActivePrinter
 
'Set active printer
ActivePrinter = GetFullNetworkPrinterName("Mono Simplex")
 
'For testing
''ActivePrinter = "CutePDF Writer"
 
Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterUpperBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
 
  iSection = iSection + 1
  '
Next oSct
 
Application.PrintOut FileName:="", Range:=wdPrintAllDocument
'switch printer back
ActivePrinter = sCurrentPrinter
 
Options.PrintDraft = sDraft
 
End Sub

Dim oSct As Section
Dim iSection As Integer
'
iSection = 1
'
For Each oSct In ActiveDocument.Sections
  With ActiveDocument.Sections(iSection).PageSetup
    .FirstPageTray = wdPrinterUpperBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
 
  iSection = iSection + 1
  '
Next oSct

Dim oSct As Section
'
For Each oSct In ActiveDocument.Sections
  With oSct.PageSetup
    .FirstPageTray = wdPrinterUpperBin
    .OtherPagesTray = wdPrinterMiddleBin
  End With
Next oSct

Dim iSection As Long
With ActiveDocument
  For iSection = 1 To .Sections.Count
    With .Sections(iSection).PageSetup
      .FirstPageTray = wdPrinterUpperBin
      .OtherPagesTray = wdPrinterMiddleBin
    End With
    If iSection Mod 20 = 0 Then DoEvents
  Next iSection
End With