printing .doc, .xls, and .pdf files from a list of filenames using an excel vba macro

printing .doc, .xls, and .pdf files from a list of filenames using an excel vba macro

• nmasao

  I usually use these functions when printing a list of pdfs to check when the printer has room for more jobs:

  
  Private Declare Function GetProfileString Lib "kernel32" 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 EnumJobs Lib "winspool.drv" Alias "EnumJobsA" (ByVal hPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, ByVal Level As Long, pJob As Byte, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
  Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As Any) As Long
  Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
  Private Declare Function PrinterProperties Lib "winspool.drv" (ByVal hwnd As Long, ByVal hPrinter As Long) As Long
  Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG_TYPE) As Long
  Private Declare Function GetForegroundWindow Lib "user32" () As Long
  
  Private Function GetDefPrinterName() As String
  Dim sBuff As String * 255
  Dim l As Long
  Dim arr

  l = GetProfileString("windows", "device", "", sBuff, 255)
  arr = Split(Left$(sBuff, l), ",", , vbTextCompare)
  GetDefPrinterName = arr(0)
  End Function

  Public Function WaitForEndPrint() As Boolean
  Dim hPrinter As Long ' handle to the default printer once it is opened
  Dim arraybuf() As Long ' resizable array used as a buffer
  Dim needed As Long ' receives space needed in the buffer array
  Dim numitems As Long ' receives the number of items returned
  Dim retval As Long ' return value

  OpenPrinter GetDefPrinterName(), hPrinter, ByVal 0&

  ' Enumerate the default printer's print jobs currently queued
  ' Determine how much space is needed to get the print jobs' information.
  retval = EnumJobs(hPrinter, 0, 100, 2, ByVal 0, 0, needed, numitems)
  ' Resize the array buffer to the needed size in bytes.
  ReDim arraybuf(0 To needed / 4 - 1) ' remember each element is 4 bytes
  ' Retrieve the information about the print jobs.
  retval = EnumJobs(hPrinter, 0, 100, 2, ByVal arraybuf(0), needed, needed, numitems)
  ' Display the number of print jobs currently in the queue.
  Do While numitems > 0
  DoEvents
  Loop
  ClosePrinter hPrinter
  WaitForEndPrint = True’
  End Function

  and use them in my printing function roughly like this:

  For i = 0 To printableamount
  ' ShellExecute returns then handle to the opened program if not erroneous
  hwndret = ShellExecute(0, "print", FilePath(i), vbNullString, vbNullString, vbMinimizedFocus)
  ' if hwndret is <= 32 then error in printing
  If Not (hwndret <= 32) Then
  ' Waits for the printer to print the job before adding another
  WaitForEndPrint
  else
  ' Error handling
  end if
  ' Next file to print
  next i
  
  Hope this is applicable to your case

  
  

• Darko01

  If the full pathname of each file is formatted as a hyperlink (Insert Hyperlink), as Jim has indicated, then the following code cycles through the Hyperlinks collection on worksheet 1 and gets the full pathname of the file:
  
  Dim h as Hyperlink
  For Each h in Worksheets(1).Hyperlinks
  Debug.Print h.Name
  Next
  
  h.Name can then be used in the ShellExecute call.
  
  hth
  
  
  
  
  

• Katee

  Thank you so much for your responses!

  I have tried your print routines. However, it seems that only some of the pdf files get sent to the printer. Maybe I have a problem with the "WaitForEndPrint" function. After the EnumJobs function, the "needed" and "numitems" variables are always 0. Do you have any idea would I could be missing.

  Also, is there a way to hide Acrobat from view as it is cycling through the pdfs. I have tried using SW_HIDE but in this case, nothing at all gets sent to the printer. Also, if it has to be visible, is there a way from excel macro to close Adobe reader after all printing complete so it isn't left out there.

  Thank you again for all your help.

  
  

• SADG!RL

  Hi there. Thank you so much for your help!!!

  When I run this, I get an error on the line:

  ShellExecute Application.hwnd, "print", sFile, vbNullString, "C:\", 0

  stating

  "object does not support this property or method"

  
  
  

• Usr_Anonymous

  Hi there,

  Do me a favor and change the call to ShellExecute to.

  Dim lret as Long

  lret = ShellExecute Nothing, "print", sFile, vbNullString, "C:\", 0

  Once the code has executed check the value of lret against the list here...

  http://support.microsoft.com/ kbid=238245

  This will give you an idea of whats going wrong.

  
  
  

• Pete In TX

  Hi again Jim, that might be the Application.Hwnd thats causing that error. I believe you can use Nothing in its place.

  ShellExecute Nothing, "print", sFile, vbNullString, "C:\", 0

  
  
  

• DoReMeFaSo

  Thank you very much for these messages. I have been trying to use this solution as well. I'm not getting any error messages, but when I run it, nothing is being sent to the printer. Do you have any idea what I could be missing

  (My 'problem' is that I have a list of pdf files that I need to loop through to send to the printer from the excel macro).

  Thank you for any suggestion.

  
  

• Justin Lee

  Hiya! Sorry for the incomplete code, it seems printing with shellexecute is really hard when printing multiple files... in my code I wait for the called application to surface and after that I run WaitForEndPrint. But my code is old and now when I take a look at it, it doesn't seem to function right. Here's an update:
  
  Public Function WaitForEndPrint() As Boolean
  Dim hPrinter As Long ' handle to the default printer once it is opened
  Dim arraybuf() As Byte ' resizable array used as a buffer
  Dim needed As Long ' receives space needed in the buffer array
  Dim numitems As Long ' receives the number of items returned
  Dim retval As Long ' return value
  Dim EndTime As Single, Start As Single, Finish As Single
  EndTime = 30
  OpenPrinter GetDefPrinterName(), hPrinter, ByVal 0&

  ' -- Enumerate the default printer's print jobs currently queued. --
  ' Determine how much space is needed to get the print jobs' information.
  retval = EnumJobs(hPrinter, 0, 100, 2, ByVal 0, 0, needed, numitems)
  If needed > 0 Then
  ReDim arraybuf(needed - 1) As Byte
  retval = EnumJobs(hPrinter, 0, 100, 2, arraybuf(0), needed, needed, numitems)
  Start = Timer
  Do While numitems > 0 And Timer < (Start + EndTime)
  DoEvents
  ReDim arraybuf(needed - 1) As Byte ' remember each element is 4 bytes
  retval = EnumJobs(hPrinter, 0, 100, 2, arraybuf(0), needed, needed, numitems)
  Loop
  End If
  ClosePrinter hPrinter
  WaitForEndPrint = True
  End Function

  Notice the timer that exits the do while -loop in case the printer takes too long printing... this leaves the print jobs in queue, but doesn't stop the application in case the printer is for example off.:)
  
  Here's the code for printing. Notice that I swapped ShellExecute with ShellExecuteEx, because I noticed the handle returned by ShellExecute is just a relic of times passed and you won't be able to use it for anything worth mentioning... ShellExecuteEx returns a handle to the started process, so it's useable.:) I also added WaitForSingleObject to wait for the called application to start before going into WaitForEndPrint. Phew, this seems like something glued together with gum, but...
  
  'API-functions and Consts
  Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  Private Declare Function ShellExecuteEx Lib "shell32.dll" (SEI As SHELLEXECUTEINFO) As Long
  
  Private Type SHELLEXECUTEINFO
  cbSize As Long
  fMask As Long
  hwnd As Long
  lpVerb As String
  lpFile As String
  lpParameters As String
  lpDirectory As String
  nShow As Long
  hInstApp As Long
  lpIDList As Long
  lpClass As String
  hkeyClass As Long
  dwHotKey As Long
  hIcon As Long
  hProcess As Long
  End Type
  Const SEE_MASK_NOCLOSEPROCESS = &H40
  Const SEE_MASK_FLAG_NO_UI = &H400
  
  'Function
  Dim ShllExNfo As SHELLEXECUTEINFO
  For i = 0 To printableamount
  With ShllExNfo
  .cbSize = Len(ShllExNfo)
  .hwnd = 0&
  .fMask = SEE_MASK_FLAG_NO_UI Or SEE_MASK_NOCLOSEPROCESS
  .lpFile =FilePaths(i)
  .lpVerb = "print"
  .lpParameters = vbNullChar
  .lpDirectory = vbNullChar
  .nShow = SW_HIDE 'vbMinimizedFocus
  .hInstApp = 0
  .lpIDList = 0
  End With
  ShellExecuteEx ShllExNfo
  hwndret = ShllExNfo.hInstApp
  l = ShllExNfo.hProcess
  ' if hwndret is <= 32 then error in printing
  If Not (hwndret <= 32) Then
  'First we wait for the process to start
  WaitForSingleObject l, 3600 'l is the processhandle, 3600 is time to wait for it in milliseconds
  ' Waits for the printer to print the job before adding another
  WaitForEndPrint
  else
  ' Error handling
  end if
  ' Next file to print
  next i
  
  I think you could use the handle hProcess to close the window, but I don't have time to check now. Also, you should make some checking with WaitForSingleObject so that everything goes smoothly... I haven't had the time to do extensive testing, so be careful!;) I'll be gone for the next couple of weeks, so you know I haven't ran away after reading difficult questions!
  
  Cheers

  
  

• Jaime Stuardo

  Nice one Josh!
  
  

• Tim Anderson

  Hello Jim,

  Yip you need to loop over the cells in the worksheet in Excel, best to do it by index. You'll want to loop down the rows in a column printing all the files. Since you want to print them in their application your want to use the Windows API.

  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

  Public Sub Test()

  Dim sFile As String
  Dim nRow As Integer
  For nRow = 1 To 1000
  sFile = ActiveSheet.Cells(nRow, 1).Value
  ShellExecute Application.hwnd, "print", sFile, vbNullString, "C:\", 0
  Next

  End Sub

  That code willwork however there is a problem with printing one file after the other and that is does the printer have enough umph

  
  
  
• printing .doc, .xls, and .pdf files from a list of filenames using an excel vba macro