Hello all!
I'm Jim from Western NY.
Forgive me if I have posted in the wrong forum. If I have, just let me know and I'll comply.
Here's my question:
I am wanting to develop a macro for excel which will read
(from a worksheet) a list of hyperlinks to pdf, .doc, and .xls files and
print them using the appropriate application (acrobat, word, excel).
Theoretically, I know I would have to use some kind of for-next and/or case structure but I don't know how to implement it. Someone has helped me get started, but the code I have (predictably) only works for Word documents:
Sub PrintDocuments()
'Must set a reference (Tools | References) to:
' Microsoft Word 11.0 Object Library
'11.0 = 2003, 10.0 = 2002 (XP), 9.0 = 2000, etc.
Dim WDApp As Word.Application, WDDoc As Word.Document
Dim c As Range, rngFiles As Range
Set rngFiles = Range("A2", Cells(Rows.Count, "A").End(xlUp))
Set WDApp = New Word.Application
WDApp.Visible = True
For Each c In rngFiles
Set WDDoc = WDApp.Documents.Open(c.Value)
WDDoc.PrintOut copies:=1
WDDoc.Close False
Set WDDoc = Nothing
Next c
WDApp.Quit False
Set WDApp = Nothing
End Sub
And here is a sample of the file list, which will change in contents and number of elements:
C:\Project Books\Templates\Clearance Sheets\BrgThrust&JournalClr.doc
C:\Project Books\Templates\Clearance Sheets\BrgThrust.doc
C:\Project Books\Templates\Clearance Sheets\BrgThrustPadInsp.pdf
C:\Project Books\Templates\Clearance Sheets\RotorAxialPosition.xls
C:\Project Books\Templates\Clearance Sheets\RotorAxPosThrustClr.doc
ANy help would be greatly appreciated.

printing .doc, .xls, and .pdf files from a list of filenames using an excel vba macro
coyotedw
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
Stefan Weitz
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"
WarAngel
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
Frans Bouma - C&#35; MVP
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.
Hades Pta
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
ekynox
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
FrozenCow
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
Yousef ED
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.
Craig Wiley
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.
papaoso