jbliss503
10-06-2011, 10:10 AM
I am using VBA for Word and trying to print about 1200 files in order by date created. I have been attempting to do this by compiling an array with all of the files that i need to print. I am trying to figure out if it is possible to then sort the array (either pre or post creation) by date created. Please see the code below. Any help that will be greatly appreciated.
Sub batch_print()
Dim sMyDir, docNameNoXt, sDocList, sDocName, docNamePdf, docNamePdfPrint, printNameWord, sPrintDir As String
Dim bkprint As Boolean
Dim iCount, iCount3 As Integer
Dim printArray(0 To 1500) As Variant
'set background print option
bkprint = Options.PrintBackground
Options.PrintBackground = True
'file pathway
sMyDir = "\\nas-cp1b\data\MIR\GTS-Miramar\Gas Mapping\autoGenAsbuilt\workOrders\"
sPrintDir = "\\nas-cp1b\data\MIR\GTS-Miramar\Gas Mapping\autoGenAsbuilt\workOrders\printed\"
'document name
sDocList = Dir$(sMyDir & "*.docx")
'set counter value
iCount = 0
'Compile Array
While sDocList <> ""
'assign files to array
printArray(iCount) = sDocList
iCount = iCount + 1
sDocList = Dir$
Wend
iCount3 = 0
If iCount >= 50 Then
For c = 1 To 50
'print files
printNameWord = sMyDir & printArray(iCount3)
Application.PrintOut Background:=True, FileName:=printNameWord, To:="p-00453", collate:=False
Call pause(2)
docNamePdfPrint = Left(printNameWord, InStr(1, printNameWord, ".") - 1)
Shell ("C:\Program Files\Adobe\Acrobat 9.0\Acrobat\acrobat.exe /n /t /h" & docNamePdfPrint), vbHide
Call pause(3)
'change extension to PDF
docNameNoXt = Left(printArray(iCount3), InStr(1, printArray(iCount3), ".") - 1)
docNamePdf = docNameNoXt & ".PDF"
'move printed documents to sPrintDir
Name (sMyDir & printArray(iCount3)) As (sPrintDir & printArray(iCount3))
Name (sMyDir & docNamePdf) As (sPrintDir & docNamePdf)
iCount3 = iCount3 + 1
Next c
Else
For c = 1 To iCount
'print files
printNameWord = sMyDir & printArray(iCount3)
Application.PrintOut Background:=True, FileName:=printNameWord, To:="p-00453", collate:=False
Call pause(2)
docNamePdfPrint = Left(printNameWord, InStr(1, printNameWord, ".") - 1)
Shell ("C:\Program Files\Adobe\Acrobat 9.0\Acrobat\acrobat.exe /n /t /h" & docNamePdfPrint), vbHide
Call pause(3)
'change extension to PDF
docNameNoXt = Left(printArray(iCount3), InStr(1, printArray(iCount3), ".") - 1)
docNamePdf = docNameNoXt & ".PDF"
'move printed documents to sPrintDir
Name (sMyDir & printArray(iCount3)) As (sPrintDir & printArray(iCount3))
Name (sMyDir & docNamePdf) As (sPrintDir & docNamePdf)
iCount3 = iCount3 + 1
Next c
End If
Options.PrintBackground = bkprint
End Sub
Sub pause(seconds As Double)
Dim start As Long
start = Timer
While Timer < start + seconds
DoEvents
Wend
End Sub
Sub batch_print()
Dim sMyDir, docNameNoXt, sDocList, sDocName, docNamePdf, docNamePdfPrint, printNameWord, sPrintDir As String
Dim bkprint As Boolean
Dim iCount, iCount3 As Integer
Dim printArray(0 To 1500) As Variant
'set background print option
bkprint = Options.PrintBackground
Options.PrintBackground = True
'file pathway
sMyDir = "\\nas-cp1b\data\MIR\GTS-Miramar\Gas Mapping\autoGenAsbuilt\workOrders\"
sPrintDir = "\\nas-cp1b\data\MIR\GTS-Miramar\Gas Mapping\autoGenAsbuilt\workOrders\printed\"
'document name
sDocList = Dir$(sMyDir & "*.docx")
'set counter value
iCount = 0
'Compile Array
While sDocList <> ""
'assign files to array
printArray(iCount) = sDocList
iCount = iCount + 1
sDocList = Dir$
Wend
iCount3 = 0
If iCount >= 50 Then
For c = 1 To 50
'print files
printNameWord = sMyDir & printArray(iCount3)
Application.PrintOut Background:=True, FileName:=printNameWord, To:="p-00453", collate:=False
Call pause(2)
docNamePdfPrint = Left(printNameWord, InStr(1, printNameWord, ".") - 1)
Shell ("C:\Program Files\Adobe\Acrobat 9.0\Acrobat\acrobat.exe /n /t /h" & docNamePdfPrint), vbHide
Call pause(3)
'change extension to PDF
docNameNoXt = Left(printArray(iCount3), InStr(1, printArray(iCount3), ".") - 1)
docNamePdf = docNameNoXt & ".PDF"
'move printed documents to sPrintDir
Name (sMyDir & printArray(iCount3)) As (sPrintDir & printArray(iCount3))
Name (sMyDir & docNamePdf) As (sPrintDir & docNamePdf)
iCount3 = iCount3 + 1
Next c
Else
For c = 1 To iCount
'print files
printNameWord = sMyDir & printArray(iCount3)
Application.PrintOut Background:=True, FileName:=printNameWord, To:="p-00453", collate:=False
Call pause(2)
docNamePdfPrint = Left(printNameWord, InStr(1, printNameWord, ".") - 1)
Shell ("C:\Program Files\Adobe\Acrobat 9.0\Acrobat\acrobat.exe /n /t /h" & docNamePdfPrint), vbHide
Call pause(3)
'change extension to PDF
docNameNoXt = Left(printArray(iCount3), InStr(1, printArray(iCount3), ".") - 1)
docNamePdf = docNameNoXt & ".PDF"
'move printed documents to sPrintDir
Name (sMyDir & printArray(iCount3)) As (sPrintDir & printArray(iCount3))
Name (sMyDir & docNamePdf) As (sPrintDir & docNamePdf)
iCount3 = iCount3 + 1
Next c
End If
Options.PrintBackground = bkprint
End Sub
Sub pause(seconds As Double)
Dim start As Long
start = Timer
While Timer < start + seconds
DoEvents
Wend
End Sub