我有一个VBScript，试图将所选目录中找到的所有PDF文件合并到第一页。我已经成功地编写了下面的代码来合并它们，但是第一个文件具有所有页面，而不仅仅是第一个。我该如何只打开第一个文件的第一页？
i = 0
ReDim arPDFFiles(i)
Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "H:\Data"
Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
strFileName = objFile.Name
If objFSO.GetExtensionName(strFileName) = "pdf" Then
arPDFFiles(i) = Files.Path
i = i + 1
ReDim Preserve arPDFFiles(i)
End If
Next
ShowSubfolders objFSO.GetFolder(objStartFolder)
SingleSorter(arPDFFiles)
MergePDFs arPDFFiles, "H:/Test.pdf"
MsgBox i - 1 & " PDFs were successfully merged.", vbInformation, "Success"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MergePDFs(arPDFFiles, strSaveAs)
Dim app, objAcroPDDocDestination, objCAcroPDDocSource, i, iFailed
'On Error GoTo NoAcrobat:
'Initialize the Acrobat objects
Set app = CreateObject("AcroExch.App")
Set objCAcroPDDocDestination = CreateObject("AcroExch.PDDoc")
Set objCAcroPDDocSource = CreateObject("AcroExch.PDDoc")
objCAcroPDDocDestination.Open (arPDFFiles(LBound(arPDFFiles))) 'open the first file
For i = LBound(arPDFFiles) + 1 To UBound(arPDFFiles)
objCAcroPDDocSource.Open (arPDFFiles(i))
If objCAcroPDDocDestination.InsertPages(objCAcroPDDocDestination.GetNumPages - 1, objCAcroPDDocSource, 0, 1, 0) Then
MergePDFs = True
Else
'failed to merge one of the PDFs
iFailed = iFailed + 1
End If
objCAcroPDDocSource.Close
Next
objCAcroPDDocDestination.Save 1, strSaveAs 'Save it as a new name
objCAcroPDDocDestination.Close
Set objCAcroPDDocSource = Nothing
Set objCAcroPDDocDestination = Nothing
'NoAcrobat:
'If iFailed <> 0 Then
' MergePDFs = False
'End If
On Error GoTo 0
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
If Subfolder.Name = "ParticleData" Or Subfolder.Name = "ParticleDataReports" Then
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For each Files in colFiles
If LCase(InStr(1,Files, ".pdf")) > 1 Then
If IsEmpty(Files.Path) Then
Else
arPDFFiles(i) = Files.Path
i = i + 1
ReDim Preserve arPDFFiles(i)
End If
End If
Next
End If
ShowSubFolders Subfolder
Next
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SingleSorter( byRef arrArray )
Dim row, j
Dim StartingKeyValue, NewKeyValue, swap_pos
For row = 0 To UBound( arrArray ) - 1
'Take a snapshot of the first element
'in the array because if there is a
'smaller value elsewhere in the array
'we'll need to do a swap.
StartingKeyValue = arrArray ( row )
NewKeyValue = arrArray ( row )
swap_pos = row
For j = row + 1 to UBound( arrArray )
'Start inner loop.
If arrArray ( j ) < NewKeyValue Then
'This is now the lowest number -
'remember it's position.
swap_pos = j
NewKeyValue = arrArray ( j )
End If
Next
If swap_pos <> row Then
'If we get here then we are about to do a swap
'within the array.
arrArray ( swap_pos ) = StartingKeyValue
arrArray ( row ) = NewKeyValue
End If
Next
ReDim arPDFFiles(row - 1)
For i = LBound(arrArray) To UBound(arrArray)
If Not IsEmpty(arrArray(i)) Then
arPDFFiles(i - (j - row)) = arrArray(i)
End If
Next
End Function