I often have to print a lot of word documents. I know how to print a lot of
Excel documents with a VBA macro. But how can I give in the filenames in a
Excel sheet and print the documents with Word.
So the complete action would be:
- give the variables in Excel
- open the documents in Word
- print the document
- close the document without saving
- open the next document
Can please somebody help me with this problem ?
This is a little rough ("Fresh baked in 15 minutes" wonder-code), but
I've tested it and it works. It should be well enough documented for
you to follow what it's doing. Post again if you run into any problems
with it:
Sub PrintWordDocuments()
'This array will hold our file names
Dim l_IndexDocNames As Long
Dim sa_DocNames() As String
'Counter variables.
Dim l_CounterRow As Long
Dim l_CounterIndex As Long
'Word object variables.
Dim wdApp As Object
Dim wdDoc As Object
'Rudimentary error handling
On Error GoTo ErrorHandler
'Let's say that the word document names
'are in column A. We'll gather them first.
'Our array of file names is set to -1;
'the array itself will start from 0.
'If the counter is still -1 after we look through
'column A, we'll know something's wrong.
l_IndexDocNames = -1
'Start at row 1
l_CounterRow = 1
'Keep going down column A until we hit a blank cell.
Do While ActiveSheet.Cells(l_CounterRow, 1) <> ""
'Check that there really is such a file.
If Dir(CStr(ActiveSheet.Cells(l_CounterRow, 1).Value), _
vbNormal) <> "" Then
'Increment the array index
l_IndexDocNames = l_IndexDocNames + 1
'Make room for the new element, but don't
'lose what's already there.
ReDim Preserve sa_DocNames(l_IndexDocNames)
'Add the file to the array.
sa_DocNames(l_IndexDocNames) = _
CStr(ActiveSheet.Cells(l_CounterRow, 1).Value)
End If
l_CounterRow = l_CounterRow + 1
Loop
'Check that we got SOME valid names
If l_IndexDocNames = -1 Then
Beep
MsgBox "No valid names in column A!"
GoTo ExitPoint
End If
'Open a session of word. (It runs in the background
'and is not visible.)
Set wdApp = CreateObject("Word.Application")
'Ensure the hidden Word session shows no
'dialogs.
wdApp.DisplayAlerts = 0
'Loop through the array of valid file names
For l_CounterIndex = LBound(sa_DocNames) To UBound(sa_DocNames)
'Open the document
Set wdDoc = wdApp.Documents.Open(sa_DocNames(l_CounterIndex))
'Default print
wdDoc.PrintOut
'Close without saving
wdDoc.Close False
Next
ExitPoint:
'This is the cleanup section. If it doesn't work,
'you can't do much about it so ignore errors.
On Error Resume Next
'Reset the alerts property and exit.
'(False = no saving)
wdApp.DisplayAlerts = -1
wdApp.Quit False
Set wdApp = Nothing
Set wdDoc = Nothing
Exit Sub
ErrorHandler:
'Report the error, then clean up.
MsgBox Err.Number & vbCrLf & Err.Description
Resume ExitPoint
End Sub
