I am trying to set up a means of printing a list of Word docs in an
excel spreadsheet. I cannot print off the doc. the code is below:
Sub PrintWordDocuments()
Dim l_IndexDocNames As Long
Dim sa_DocNames() As String
Dim l_CounterRow As Long
Dim l_CounterIndex As Long
Dim appWD As Object
Dim wdDoc As Object
On Error GoTo ErrorHandler
l_IndexDocNames = -1
l_CounterRow = 1
Do While ActiveSheet.Cells(l_CounterRow, 1) <> ""
If Dir(CStr(ActiveSheet.Cells(l_CounterRow, 1).Value), vbNormal)
<> "" Then
l_IndexDocNames = l_IndexDocNames + 1
ReDim Preserve sa_DocNames(l_IndexDocNames)
sa_DocNames(l_IndexDocNames) = CStr(ActiveSheet.Cells(l_CounterRow,
1).Value)
End If
l_CounterRow = l_CounterRow + 1
Loop
If l_IndexDocNames = -1 Then
Beep
MsgBox "No Valid names in Column A"
GoTo Exitpoint
End If
Set appWD = CreateObject("Word.Application")
appWD.DisplayAlerts = 0
For l_CounterIndex = LBound(sa_DocNames) To UBound(sa_DocNames)
Set wdDoc = appWD.Documents.Open(sa_DocNames(l_CounterIndex))
wdDoc.PrintOut
wdDoc.Close False
Next
Exitpoint:
appWD.DisplayAlerts = -1
appWD.Quit
Set appWD = Nothing
Set wdDoc = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Resume Exitpoint
End Sub
The person will choose what docs they require from a list any help
is gratefull