Merging Files only works every second time Excel VBA


#1

Hi,

I have some VBA code to merge pdf files into a single PDF.

I have the following code…

Option Explicit

Sub Test_PDFCreatorCombine2()
Dim fn(0 To 3) As String, s As String

fn(0) = ThisWorkbook.Path & “\P1.pdf”
fn(1) = ThisWorkbook.Path & “\P2.pdf”
fn(2) = ThisWorkbook.Path & “\P3.pdf”
fn(3) = ThisWorkbook.Path & “\P4.pdf”
s = ThisWorkbook.Path & “\PDFCreatorCombined.pdf”

PDFCreatorCombine fn(), s

If vbYes = MsgBox(“Open Merged Data File? " & vbCr & vbCr & _
s, vbYesNo + vbQuestion, “Open?”) Then Shell (“cmd /c " & “””” & s & “”"")
End Sub

’ Older version examples by Ken Puls,

’ Macro Purpose: Print to PDF file using PDFCreator v2.3.2, Kenneth Hobson, Oct. 8, 2016

’ Designed for early bind, set reference to: PDFCreator - Your OpenSource PDF Solution
’ sPDFName() assumed to be 0 index based string array.
Sub PDFCreatorCombine(sPDFName() As String, sMergedPDFname As String, _
Optional tfKillMergedFile As Boolean = True)
Dim oPDF As PdfCreatorObj
Dim q As Queue
Dim pj As PrintJob
Dim i As Integer, ii As Integer
Dim fso As Object, tf As Boolean
Dim s() As String

On Error GoTo EndSub
Set fso = CreateObject(“Scripting.FileSystemObject”)
If tfKillMergedFile And fso.FileExists(sMergedPDFname) Then Kill sMergedPDFname

For i = 0 To UBound(sPDFName)
If fso.FileExists(sPDFName(i)) Then
ii = ii + 1
ReDim Preserve s(1 To ii)
s(ii) = sPDFName(i)
End If
Next i

Set q = New Queue
With q
.Initialize

  Set oPDF = New PdfCreatorObj
  
  
  For i = 1 To UBound(s)
    oPDF.AddFileToQueue s(i)
  Next i

’ tf = .WaitForJobs(i, 5) 'Wait 5 seconds for jobs to queue

  .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

End With
EndSub:
If Not q Is Nothing Then q.ReleaseCom
Set q = Nothing
Set pj = Nothing
Set oPDF = Nothing

End Sub

This works perfectly every second time I run it with every other time only result showing the combined PDF to only containing the contains of P1.pdf

However it appears that it is only when the same files are attempted to be merged for a second time that this occurs.

So I setup a second routine which merges P5,6,7,8 together. When I open the file I can

merge P1-4 perfect
merge p5-8 perfect
merge p1-4 - only P1 in merged doc
merge p5-8 only P5 in merged doc
merge p5-8 perfect
merge p5-8 only P5 in merged doc
merge P1-4 perfect

Closing and reopening excel at any time though the sequence will reset and work the first time the files are merged again.


#2

I also have this exact issue. Any help would be much appreciated.