[Aalt]

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 ?

[Hank Scorpio]

On Mon, 14 Jul 2003 19:56:52 GMT, "Aalt" wrote:

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

---------------------------------------------------------
Hank Scorpio
scorpionet who hates spam is at iprimus.com.au (You know what to do.)
* Please keep all replies in this Newsgroup. Thanks! *

[Aalt]

Thank you Hank,

I´ve tested it and it works. Thank you so much. I will adjust it to further
needs.

Greatings,
Aalt

"Hank Scorpio" schreef in bericht
...
On Mon, 14 Jul 2003 19:56:52 GMT, "Aalt" wrote:

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

---------------------------------------------------------
Hank Scorpio
scorpionet who hates spam is at iprimus.com.au (You know what to do.)
* Please keep all replies in this Newsgroup. Thanks! *