Problem combining/saving pdfs in VBA MS Access

[james_1213]

I have a problem combining pdfs using VBA in Access.  The debug print says that all of the "Open", "Insertpages" functions are "true", but the final "Save" returns "false", and when the doc is opened the inserted pages are not there.  In this example there are two attachments.

----

Private Sub CmdPDF_Click()

Dim PDFindex As Integer
Dim PDFfileName As String
Dim CEUCertT As Recordset
Dim AttachmentAry() As String
Dim DestApp As Acrobat.AcroApp
Dim PDDocDest As New Acrobat.AcroPDDoc
Dim PDDocSource As New Acrobat.AcroPDDoc

If Me.ChkAttach = True Then

Set DestApp = CreateObject("AcroExch.App")
Set PDDocDest = CreateObject("AcroExch.PDDoc")
Set PDDocSource = CreateObject("AcroExch.PDDoc")

Set CEUCertT = CurrentDb.OpenRecordset("Continuing Ed")
k = 0

With CEUCertT
.MoveLast
.MoveFirst
StartDate = DateValue(Me.RepPeriodStart.Value)
ExpirDate = DateValue(Me.ExpDate.Value)
'k = .Fields("Attachment").Value
For i = 1 To .RecordCount
CompDate = DateValue(.Fields("Completion Date"))
If (CompDate > StartDate) And (CompDate <= ExpirDate) Then
If Not IsNull(.Fields("Attachment")) Then
k = k + 1
End If
End If
.MoveNext
Next i

If k = 0 Then ' Test for attachments
MsgBox "There are no attachments."
Exit Sub
End If

ReDim AttachmentAry(1 To k) As String
k = 1
.MoveLast
.MoveFirst

For i = 1 To .RecordCount
CompDate = DateValue(.Fields("Completion Date"))
If (CompDate > StartDate) And (CompDate <= ExpirDate) Then
If Not IsNull(.Fields("Attachment")) Then
AttachmentAry(k) = .Fields("Attachment").Value
k = k + 1
End If
End If
.MoveNext
Next i
End With


Set CEUCertT = Nothing

With Report_StateTranscript
PDFfileName = .State.Value & " CEU Transcript - " & .ArchBig.Value & " - " & .LicNo.Value & " - " & _
Replace(.RepPeriodStart.Value, "/", "-") & " to " & Replace(.ExpDate.Value, "/", "-") & ".pdf"
End With

With Application.FileDialog(2)

.Title = "Save workbook as PDF"
.InitialFileName = PDFfileName

If .Show Then
DoCmd.OutputTo acOutputReport, "StateTranscript", acFormatPDF, .SelectedItems(1)

Main = PDDocDest.Open(.SelectedItems(1))

While PDDocDest Is Nothing
Set PDDocDest = DestApp.GetActiveDoc
Wend

Debug.Print "SOURCE DOC OPENED & PDDOC SET: " & Main

For j = 1 To UBound(AttachmentAry)
SorDoc = AttachmentAry(j)
Adding = PDDocSource.Open(SorDoc)
Debug.Print "DOC TO INSERT OPENED SUCCESSFULLY: " & Adding

PDestStart = PDDocDest.GetNumPages()
PSourceStart = PDDocSource.GetNumPages()

Main = PDDocDest.InsertPages(PDestStart - 1, PDDocSource, 0, PSourceStart, 0)
Debug.Print "PAGES INSERTED SUCCESSFULLY: " & Main

PDDocSource.Close
Next

Main = PDDocDest.Save(PDSaveFull, .SelectedItems(1))
Debug.Print "PRIMARYDOC SAVED PROPERLY: " & Main

'main = PDDocDest.Close
'Debug.Print "PRIMARYDOC SAVED PROPERLY: " & Main

'DestApp.CloseAllDocs

Set PDDocDest = Nothing
Set PDDocSource = Nothing

Application.FollowHyperlink .SelectedItems(1), , True 'Open newly created doc
End If

End With

DoCmd.Close acReport, "StateTranscript"
DoCmd.Close acForm, "Check CE"

End If

End Sub

-----

DEBUG:

SOURCE DOC OPENED & PDDOC SET: True
DOC TO INSERT OPENED SUCCESSFULLY: True
PAGES INSERTED SUCCESSFULLY: True
DOC TO INSERT OPENED SUCCESSFULLY: True
PAGES INSERTED SUCCESSFULLY: True
PRIMARYDOC SAVED PROPERLY: False

[Bernd Alheit · Accepted solution]

Is the full path at save correct?

[james_1213]

Thanks for the pointer, it appears that the ".save" function cannot "overwrite" an existing file, so I changed the folder to a new folder, and it works. 🙂