Batch Printing from Word

[sjhime]

I've searched the forum and was unable to find an answer. I have a number of different documents in different folders that I need to print in a specific order. Three of the documents should print a single copy and the other document should print n number of documents. n = field in an access database. The documents are created using VBA and are saved in separate folder but numbered sequentially. For example,

Packet Coversheet pr_1_1.docx
Packet Coversheet pr_1_2.docx
Packet Coversheet pr_1_3.docx

Above documents are saved in "Packet Coversheet" folder.

Survey instructions pr_1_1.docx
Survey instructions pr_1_2.docx
Survey instructions pr_1_3.docx

Above documents are saved in "Survey Instructions" folder.

Consent cover pr_1_1.docx
Consent cover pr_1_2.docx
Consent cover pr_1_3.docx

Above documents are saved in "Consent Cover" folder.

Consent pr_1_1.docx
Consent pr_1_2.docx
Consent pr_1_3.docx

Above documents are saved in "Consent" folder.

Documents should print in their sequential order. For example:

Packet Coversheet pr_1_1.docx
Survey instructions pr_1_1.docx
Consent cover pr_1_1.docx
Consent pr_1_1.docx

Then:

Packet Coversheet pr_1_2.docx
Survey instructions pr_1_2.docx
Consent cover pr_1_2.docx
Consent pr_1_2.docx

Each document prints 1 copy except that the last document "consent pr_1_x.docx" prints the number of copies in an Access field. The number of documents in each folder varies each time they are created. It seems like this should be possible in Word VBA, but I'm racking my brain trying to figure this out. I do also have an excel sheet that contains the file path for each of these documents so, if easier, I could use that file path and have a cell containing the number of copies needed (from the Access database). Also, I could easily modify the existing directory structure to save all the files in a single directory folder, if easier.

Thank you in advance for any help you can provide!

[gmayor]

If you have the filenames complete with their filepaths in column A of an Excel worksheet (with a header row), listed in the order they are to be printed, and with the number of copies for each row to be printed in Column B , without gaps, (see attached example), then the following macro should print them in the order and with the quantities indicated:

Option Explicit
Const strWorkbook As String = "C:\Path\Forum\PrintList.xlsx" 'The workbook with the list
Const strSheet = "Sheet1" 'The worksheet with the list

Sub PrintBatch()
Dim oDoc As Document
Dim arr() As Variant
Dim iRows As Long
Dim bBackground As Boolean
    bBackground = Options.PrintBackground
    Options.PrintBackground = False
    arr = xlFillArray(strWorkbook, strSheet)
    For iRows = 0 To UBound(arr, 2)
        MsgBox arr(0, iRows) & vbCr & arr(1, iRows)
        Set oDoc = Documents.Open(arr(0, iRows))
        PrintDoc oDoc, Val(arr(1, iRows))
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
    Next iRows
    Options.PrintBackground = bBackground
lbl_Exit:
    Set oDoc = Nothing
    Exit Sub
End Sub

Sub PrintDoc(oDoc As Document, iCopies As Integer)
    oDoc.PrintOut Range:=wdPrintAllDocument, _
                  Item:=wdPrintDocumentWithMarkup, _
                  Copies:=iCopies, _
                  Pages:="", _
                  PageType:=wdPrintAllPages, _
                  Collate:=True, _
                  Background:=False, _
                  PrintToFile:=False, _
                  PrintZoomColumn:=0, _
                  PrintZoomRow:=0, _
                  PrintZoomPaperWidth:=0, _
                  PrintZoomPaperHeight:=0
lbl_Exit:
    Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long

    strWorksheetName = strWorksheetName & "$]"
    Set CN = CreateObject("ADODB.Connection")
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

[sjhime]

If you have the filenames complete with their filepaths in column A of an Excel worksheet (with a header row), listed in the order they are to be printed, and with the number of copies for each row to be printed in Column B , without gaps, (see attached example), then the following macro should print them in the order and with the quantities indicated:

Option Explicit
Const strWorkbook As String = "C:\Path\Forum\PrintList.xlsx" 'The workbook with the list
Const strSheet = "Sheet1" 'The worksheet with the list

Sub PrintBatch()
Dim oDoc As Document
Dim arr() As Variant
Dim iRows As Long
Dim bBackground As Boolean
    bBackground = Options.PrintBackground
    Options.PrintBackground = False
    arr = xlFillArray(strWorkbook, strSheet)
    For iRows = 0 To UBound(arr, 2)
        MsgBox arr(0, iRows) & vbCr & arr(1, iRows)
        Set oDoc = Documents.Open(arr(0, iRows))
        PrintDoc oDoc, Val(arr(1, iRows))
        oDoc.Close SaveChanges:=wdDoNotSaveChanges
    Next iRows
    Options.PrintBackground = bBackground
lbl_Exit:
    Set oDoc = Nothing
    Exit Sub
End Sub

Sub PrintDoc(oDoc As Document, iCopies As Integer)
    oDoc.PrintOut Range:=wdPrintAllDocument, _
                  Item:=wdPrintDocumentWithMarkup, _
                  Copies:=iCopies, _
                  Pages:="", _
                  PageType:=wdPrintAllPages, _
                  Collate:=True, _
                  Background:=False, _
                  PrintToFile:=False, _
                  PrintZoomColumn:=0, _
                  PrintZoomRow:=0, _
                  PrintZoomPaperWidth:=0, _
                  PrintZoomPaperHeight:=0
lbl_Exit:
    Exit Sub
End Sub

Private Function xlFillArray(strWorkbook As String, _
                             strWorksheetName As String) As Variant
Dim RS As Object
Dim CN As Object
Dim iRows As Long

    strWorksheetName = strWorksheetName & "$]"
    Set CN = CreateObject("ADODB.Connection")
    CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
                              "Data Source=" & strWorkbook & ";" & _
                              "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    Set RS = CreateObject("ADODB.Recordset")
    RS.Open "SELECT * FROM [" & strWorksheetName, CN, 2, 1

    With RS
        .MoveLast
        iRows = .RecordCount
        .MoveFirst
    End With
    xlFillArray = RS.GetRows(iRows)
    If RS.State = 1 Then RS.Close
    Set RS = Nothing
    If CN.State = 1 Then CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function

This works awesome. I may, after using it a few times remove the msgbox. But having the notification of what's printing and the number of copies is nice. Thank you very much for putting this together!!

[sjhime]

Print Run List.xlsm

This works awesome. I may, after using it a few times remove the msgbox. But having the notification of what's printing and the number of copies is nice. Thank you very much for putting this together!!

So I've encountered a new issue. The printing works great except the cell where the number of copies needed is connected through an absolute reference to another worksheet where a table is connected to an SQL query. When the table grows (after being updated) the absolute cell reference works great. But, when the SQL connected table shrinks, the Excel changes the absolute cell references to #ref error. Then, if the table grows again (after update) then Excel doesn't correct the #ref error. I know why this is happening, but how do I prevent Excel from changing the absolute cell reference to a #ref error? I've attached the workbook for reference.

Thanks for your help!!