Bom dia!!
Meus Caros estou sempre por aqui pesquisando e baixando codigos mais hoje me deparei com um problema
que na conseguir achar nas pesquisas cheguei perto mais nao tinha mais o arquivo de exemplo.
tentei de varias maneiras, tenhos os codigos mais a mensagens que exibi é que nao consegui mesclar os Pdfs
achei este post
https://www.maximoaccess.com/t15403-mescla-multiplos-pdf-s-em-um#116814
estou usando este codigo
Private Sub Comando5_Click()
Dim ArrayDePDFs(0 To 2) As String, i As Integer
Dim sMaster As String
Dim bSuccess As Boolean
'Caminhos dos PDFs que vocês gerou
csql = "SELECT * FROM RELATORIOCOMPROVPIXCAIXA WHERE [DATAS]= #" & Format(Forms!DIALOGOCAIXA![DataDeInício], "mm/dd/yyyy") & "#"
Set dyntempven = CurrentDb.OpenRecordset(csql, dbOpenDynaset)
Do While Not dyntempven.EOF
For i = LBound(ArrayDePDFs) To UBound(ArrayDePDFs) - 1
ArrayDePDFs(i) = dyntempven!LocalArquivo
dyntempven.MoveNext
Next i
Loop
sMaster = Application.CurrentProject.path & "\COMPROVANTE PIX\" & "RELCOMPROVPIX" & Format(Date, "DDMMYY") & ".pdf"
bSuccess = MergePDFs(ArrayDePDFs, sMaster)
If bSuccess = False Then MsgBox "Falha ao combinar os PDFs", vbCritical, "Falha ao combinar os PDFs"
End Sub
e uso essa funcao:
Private Function MergePDFs(arrFiles() As String, strSaveAs As String) As Boolean
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim i As Integer
Dim iFailed As Integer
On Error GoTo NoAcrobat:
Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
objCAcroPDDocDestination.Open (arrFiles(LBound(arrFiles)))
For i = LBound(arrFiles) + 1 To UBound(arrFiles)
objCAcroPDDocSource.Open (arrFiles(i))
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
MergePDFs = True
Else
iFailed = iFailed + 1
End If
objCAcroPDDocSource.Close
Next i
objCAcroPDDocDestination.Save 1, strSaveAs
objCAcroPDDocDestination.Close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
NoAcrobat:
If iFailed <> 0 Then
MergePDFs = False
End If
On Error GoTo 0
End Function
e essa mensagem que aparece quando clico em visualizar

Meus Caros estou sempre por aqui pesquisando e baixando codigos mais hoje me deparei com um problema
que na conseguir achar nas pesquisas cheguei perto mais nao tinha mais o arquivo de exemplo.
tentei de varias maneiras, tenhos os codigos mais a mensagens que exibi é que nao consegui mesclar os Pdfs
achei este post
https://www.maximoaccess.com/t15403-mescla-multiplos-pdf-s-em-um#116814
estou usando este codigo
Private Sub Comando5_Click()
Dim ArrayDePDFs(0 To 2) As String, i As Integer
Dim sMaster As String
Dim bSuccess As Boolean
'Caminhos dos PDFs que vocês gerou
csql = "SELECT * FROM RELATORIOCOMPROVPIXCAIXA WHERE [DATAS]= #" & Format(Forms!DIALOGOCAIXA![DataDeInício], "mm/dd/yyyy") & "#"
Set dyntempven = CurrentDb.OpenRecordset(csql, dbOpenDynaset)
Do While Not dyntempven.EOF
For i = LBound(ArrayDePDFs) To UBound(ArrayDePDFs) - 1
ArrayDePDFs(i) = dyntempven!LocalArquivo
dyntempven.MoveNext
Next i
Loop
sMaster = Application.CurrentProject.path & "\COMPROVANTE PIX\" & "RELCOMPROVPIX" & Format(Date, "DDMMYY") & ".pdf"
bSuccess = MergePDFs(ArrayDePDFs, sMaster)
If bSuccess = False Then MsgBox "Falha ao combinar os PDFs", vbCritical, "Falha ao combinar os PDFs"
End Sub
e uso essa funcao:
Private Function MergePDFs(arrFiles() As String, strSaveAs As String) As Boolean
Dim objCAcroPDDocDestination As Acrobat.CAcroPDDoc
Dim objCAcroPDDocSource As Acrobat.CAcroPDDoc
Dim i As Integer
Dim iFailed As Integer
On Error GoTo NoAcrobat:
Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
objCAcroPDDocDestination.Open (arrFiles(LBound(arrFiles)))
For i = LBound(arrFiles) + 1 To UBound(arrFiles)
objCAcroPDDocSource.Open (arrFiles(i))
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, objCAcroPDDocSource.GetNumPages, 0) Then
MergePDFs = True
Else
iFailed = iFailed + 1
End If
objCAcroPDDocSource.Close
Next i
objCAcroPDDocDestination.Save 1, strSaveAs
objCAcroPDDocDestination.Close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
NoAcrobat:
If iFailed <> 0 Then
MergePDFs = False
End If
On Error GoTo 0
End Function
e essa mensagem que aparece quando clico em visualizar
