trying this again folks since my prior thread (XPS merging) got zero responses.
I soon realized that using the VBA code for PDFCreator will merge PDF files, so I can move away from XPS.
My code is almost there. my only roadblock is that once each PDF gets sent to the PDFCreator Print Queue, the macro freezes until I close Adobe Acrobat (using Reader since some of the folks that I support do NOT have Pro).
I'm somewhat able to work around that by launching Adobe first, but then the PDFCreator dialogue box appears with all of the jobs queued up. I tried using a sendkeys command to work through that, but to no avail.
below is my code:
Private Sub MergePDFs_Click()
If FileThere("Acrobat.exe") Then
ShellEx "Acrobat.exe"
Else
ShellEx "AcroRd32.exe"
End If
Dim fn(0 To 20) As String, s As String
Dim p_file_name As String
Dim yearstr As String
Dim YYYYMM As String
YYYYMM = (Year(Now()) * 100) + Month(Now())
If Mid(Me.text1, 4, 2) * 1 > 96 Then
yearstr = "19" & Mid(Me.text1, 4, 2)
Else
yearstr = "20" & Mid(Me.text1, 4, 2)
End If
p_file_name = Left(Me.text1, 3) & "_" & yearstr & Right(Me.text1, 3) & "_p_" & YYYYMM & ".pdf"
fn(0) = "C:\file1.pdf"
fn(1) = "C:\file2.pdf"
fn(2) = "C:\file3.pdf"
fn(3) = "C:\file4.pdf"
fn(4) = "C:\file5.pdf"
fn(5) = "C:\file6.pdf"
fn(6) = "C:\file7.pdf"
fn(7) = "C:\file8.pdf"
s = "C:\merged_PDF_File.pdf"
PDFCreatorCombine fn(), s
If FileThere("C:\merged_PDF_File.pdf") Then
Application.FollowHyperlink "C:\merged_PDF_File.pdf"
End If
End Sub
Sub PDFCreatorCombine(sPDFName() As String, sMergedPDFname As String, Optional tfKillMergedFile As Boolean = True)
Dim oPDF As PDFCreator.PdfCreatorObj, q As PDFCreator.Queue
Dim pj As PrintJob
Dim v As Variant, i As Integer, ii As Integer
Dim fso As Object, tf As Boolean
Dim s() As String
Dim brestart As Boolean
Dim MergedPDF As String
MergedPDF = "C:\merged_PDF_File.pdf"
Set fso = CreateObject("Scripting.FileSystemObject")
If tfKillMergedFile And fso.FileExists(sMergedPDFname) Then Kill sMergedPDFname
Set q = New PDFCreator.Queue
With q
On Error Resume Next
.ReleaseCom
.Initialize
If LBound(sPDFName) = 0 Then
.WaitForJobs UBound(sPDFName) + 1, 1
Else
.WaitForJobs UBound(sPDFName), 1
End If
Set oPDF = New PDFCreator.PdfCreatorObj
tf = .WaitForJobs(ii, 5)
i = 0
For Each v In sPDFName()
If fso.FileExists(v) Then oPDF.PrintFile
i = i + 1
Next v
On Error GoTo endnow
.MergeAllJobs
Set pj = q.NextJob
With pj
.SetProfileByGuid "DefaultGuid"
.SetProfileSetting "Printing.PrinterName", "PDFCreator"
.SetProfileSetting "Printing.SelectPrinter", "SelectedPrinter"
.SetProfileSetting "OpenViewer", "false"
.SetProfileSetting "OpenWithPdfArchitect", "false"
.SetProfileSetting "ShowProgress", "false"
.ConvertTo sMergedPDFname
End With
endnow:
.ReleaseCom
End With
Set pj = Nothing
End Sub
thanks!
I soon realized that using the VBA code for PDFCreator will merge PDF files, so I can move away from XPS.
My code is almost there. my only roadblock is that once each PDF gets sent to the PDFCreator Print Queue, the macro freezes until I close Adobe Acrobat (using Reader since some of the folks that I support do NOT have Pro).
I'm somewhat able to work around that by launching Adobe first, but then the PDFCreator dialogue box appears with all of the jobs queued up. I tried using a sendkeys command to work through that, but to no avail.
below is my code:
Private Sub MergePDFs_Click()
If FileThere("Acrobat.exe") Then
ShellEx "Acrobat.exe"
Else
ShellEx "AcroRd32.exe"
End If
Dim fn(0 To 20) As String, s As String
Dim p_file_name As String
Dim yearstr As String
Dim YYYYMM As String
YYYYMM = (Year(Now()) * 100) + Month(Now())
If Mid(Me.text1, 4, 2) * 1 > 96 Then
yearstr = "19" & Mid(Me.text1, 4, 2)
Else
yearstr = "20" & Mid(Me.text1, 4, 2)
End If
p_file_name = Left(Me.text1, 3) & "_" & yearstr & Right(Me.text1, 3) & "_p_" & YYYYMM & ".pdf"
fn(0) = "C:\file1.pdf"
fn(1) = "C:\file2.pdf"
fn(2) = "C:\file3.pdf"
fn(3) = "C:\file4.pdf"
fn(4) = "C:\file5.pdf"
fn(5) = "C:\file6.pdf"
fn(6) = "C:\file7.pdf"
fn(7) = "C:\file8.pdf"
s = "C:\merged_PDF_File.pdf"
PDFCreatorCombine fn(), s
If FileThere("C:\merged_PDF_File.pdf") Then
Application.FollowHyperlink "C:\merged_PDF_File.pdf"
End If
End Sub
Sub PDFCreatorCombine(sPDFName() As String, sMergedPDFname As String, Optional tfKillMergedFile As Boolean = True)
Dim oPDF As PDFCreator.PdfCreatorObj, q As PDFCreator.Queue
Dim pj As PrintJob
Dim v As Variant, i As Integer, ii As Integer
Dim fso As Object, tf As Boolean
Dim s() As String
Dim brestart As Boolean
Dim MergedPDF As String
MergedPDF = "C:\merged_PDF_File.pdf"
Set fso = CreateObject("Scripting.FileSystemObject")
If tfKillMergedFile And fso.FileExists(sMergedPDFname) Then Kill sMergedPDFname
Set q = New PDFCreator.Queue
With q
On Error Resume Next
.ReleaseCom
.Initialize
If LBound(sPDFName) = 0 Then
.WaitForJobs UBound(sPDFName) + 1, 1
Else
.WaitForJobs UBound(sPDFName), 1
End If
Set oPDF = New PDFCreator.PdfCreatorObj
tf = .WaitForJobs(ii, 5)
i = 0
For Each v In sPDFName()
If fso.FileExists(v) Then oPDF.PrintFile
i = i + 1
Next v
On Error GoTo endnow
.MergeAllJobs
Set pj = q.NextJob
With pj
.SetProfileByGuid "DefaultGuid"
.SetProfileSetting "Printing.PrinterName", "PDFCreator"
.SetProfileSetting "Printing.SelectPrinter", "SelectedPrinter"
.SetProfileSetting "OpenViewer", "false"
.SetProfileSetting "OpenWithPdfArchitect", "false"
.SetProfileSetting "ShowProgress", "false"
.ConvertTo sMergedPDFname
End With
endnow:
.ReleaseCom
End With
Set pj = Nothing
End Sub
thanks!