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
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