MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    Mesclar vários PDFs

    avatar
    Dougtha91
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 81
    Registrado : 19/05/2017

    Mesclar vários PDFs Empty Mesclar vários PDFs

    Mensagem  Dougtha91 2/10/2018, 13:44

    Galera,
    Estou tentando executar o código abaixo, porém ele não executa de forma alguma ele nem deixa eu passar pelo código, onde esta o erro?

    Public Function MergePDFFiles(psRawPDFFilesDir As String, psSinglePDFOutputDir As String, psSinglePDFOutputName As String) As Boolean
    On Error GoTo EH
    Dim lErrNum As Long
    Dim sErrDesc As String
    Dim sMess As String
    Dim bFirstDoc As Boolean
    Dim sRawPDFFilesDir As String
    Dim sSinglePDFOutputDir As String
    Dim sSinglePDFOutputName As String
    Dim oMainDoc As Acrobat.CAcroPDDoc
    Dim oTempDoc As Acrobat.CAcroPDDoc
    'Need to use Adobe internal Java Object
    'in order to Add Book marks
    Dim oJSO As Object 'JavaScript Object
    Dim oBookMarkRoot As Object
    Dim oFolder As Scripting.Folder
    Dim saryFileSort() As String
    Dim oFile As Scripting.File
    Dim oFSO As Scripting.FileSystemObject
    Dim sBMName As String
    Dim lPos As Long
    Dim lFile As Long
    Dim lBMPageNo As Long
    sRawPDFFilesDir = psRawPDFFilesDir
    sSinglePDFOutputDir = psSinglePDFOutputDir
    sSinglePDFOutputName = psSinglePDFOutputName
    Set oFSO = New Scripting.FileSystemObject
    Set oFolder = oFSO.GetFolder(sRawPDFFilesDir)
    bFirstDoc = True


    If oFolder.Files.Count = 0 Then
    Exit Function
    End If
    'Because the FSO folder files collection


    ' does not allow for
    'Native sorting, need to plug all the fi
    ' les into an array and sort that motha
    ReDim saryFileSort(1 To oFolder.Files.Count)
    lFile = 0


    For Each oFile In oFolder.Files
    lFile = lFile + 1
    saryFileSort(lFile) = oFile.Name
    Next
    'do your sort here, or not
    'goUtil.utBubbleSort saryFileSort


    For lFile = 1 To UBound(saryFileSort, 1)


    If LCase(Right(saryFileSort(lFile), 4)) = ".pdf" Then


    If bFirstDoc Then
    bFirstDoc = False
    Set oMainDoc = CreateObject("AcroExch.PDDoc")
    oMainDoc.Open sRawPDFFilesDir & saryFileSort(lFile)
    Set oJSO = oMainDoc.GetJSObject
    Set oBookMarkRoot = oJSO.BookMarkRoot
    sBMName = saryFileSort(lFile)
    lPos = InStr(1, sBMName, "_{", vbBinaryCompare)


    If lPos > 0 Then
    sBMName = Left(sBMName, lPos - 1) & ".pdf"
    End If
    oBookMarkRoot.CreateChild sBMName, "this.pageNum =0", lFile - 1
    Else
    Set oTempDoc = CreateObject("AcroExch.PDDoc")
    oTempDoc.Open sRawPDFFilesDir & "\" & saryFileSort(lFile)
    'get the Book mark page number before th
    ' e actual instert of new pages
    lBMPageNo = oMainDoc.GetNumPages
    oMainDoc.InsertPages oMainDoc.GetNumPages - 1, oTempDoc, 0, oTempDoc.GetNumPages, 1
    oTempDoc.Close
    sBMName = saryFileSort(lFile)
    lPos = InStr(1, sBMName, "_{", vbBinaryCompare)


    If lPos > 0 Then
    sBMName = Left(sBMName, lPos - 1) & ".pdf"
    End If
    oBookMarkRoot.CreateChild sBMName, "this.pageNum =" & lBMPageNo, lFile - 1
    End If
    End If
    Next
    oMainDoc.Save 1, sSinglePDFOutputDir & "\" & sSinglePDFOutputName
    oMainDoc.Close
    MergePDFFiles = True
    CLEAN_UP:
    Set oFolder = Nothing
    Set oFile = Nothing
    Set oFSO = Nothing
    Set oBookMarkRoot = Nothing
    Set oJSO = Nothing
    Set oMainDoc = Nothing
    Set oTempDoc = Nothing
    Exit Function
    EH:
    lErrNum = Err.Number
    sErrDesc = Err.Description
    MergePDFFiles = False
    'Enter you error handler
    Set oFolder = Nothing
    Set oFile = Nothing
    Set oFSO = Nothing
    Set oBookMarkRoot = Nothing
    Set oJSO = Nothing
    Set oMainDoc = Nothing
    Set oTempDoc = Nothing

    End Function

      Data/hora atual: 23/10/2024, 04:29