VBAでリスト通りにPDF結合をする

PDFをリスト順に結合したい。
ありそうで意外となかったコードを作成しました。


    
    ' フォルダ選択ダイアログを使用してフォルダパスを取得
    Sub CombinePDFsFromList()
    Dim folderPath As String
    Dim outputFileName As String  
    Dim ws As Worksheet
    Dim acrobatObjUnion As New Acrobat.AcroPDDoc
    Dim acrobatObjInsert As New Acrobat.AcroPDDoc
    Dim pdfID_Union As Long
    Dim pdfID_Insert As Long
    Dim UniPageNum As Long: UniPageNum = 0
    Dim InsPageNum As Long
    Dim i As Long
    Dim fileName As String
    Dim filePath As String
    
    ' フォルダ選択ダイアログを使用してフォルダパスを取得
    folderPath = GetFolderPath()
    If folderPath = "" Then
        MsgBox "フォルダが選択されませんでした。処理を中止します。", vbExclamation
        Exit Sub
    End If
    
    ' フォルダパスの最後にバックスラッシュがない場合は追加
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    outputFileName = InputBox("結合後のPDFファイル名を入力してください：", "出力ファイル名入力")
    If outputFileName = "" Then Exit Sub  ' キャンセルされた場合は終了
    If Right(outputFileName, 4) <> ".pdf" Then outputFileName = outputFileName & ".pdf"
    
    ' ワークシートの設定（リストが含まれているシートを指定）
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ' 空のPDFファイルを作成
    pdfID_Union = acrobatObjUnion.Create()
    
    ' リストに従ってPDFを結合
    For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        fileName = ws.Cells(i, 1).Value
        
        ' ファイルをフォルダ内で検索
        filePath = FindFile(folderPath, fileName)
        
        If filePath <> "" Then
            ' PDFファイルを開く
            pdfID_Insert = acrobatObjInsert.Open(filePath)
            
            ' ページ数を取得
            InsPageNum = acrobatObjInsert.GetNumPages()
            
            ' PDFファイルを結合
            On Error Resume Next
            pdfID_Union = acrobatObjUnion.InsertPages(UniPageNum - 1, acrobatObjInsert, 0, InsPageNum, True)
            If Err.Number <> 0 Then
                MsgBox "エラーが発生しました: " & Err.Description & " (ファイル: " & fileName & ")", vbExclamation
                Err.Clear
            End If
            On Error GoTo 0
            
            ' 結合用に開いたPDFファイルを閉じる
            pdfID_Insert = acrobatObjInsert.Close()
            
            ' 結合ページ数に挿入したページ数を足す
            UniPageNum = UniPageNum + InsPageNum
        Else
            MsgBox "ファイルが見つかりません: " & fileName, vbExclamation
        End If
    Next i
    
    ' 結合したPDFを保存し、ファイルを閉じる
    pdfID_Union = acrobatObjUnion.Save(PDSaveFull, folderPath & outputFileName)
    pdfID_Union = acrobatObjUnion.Close
    
    ' オブジェクトを解放
    Set acrobatObjInsert = Nothing
    Set acrobatObjUnion = Nothing
    
    MsgBox "PDFの結合が完了しました。保存先: " & folderPath & outputFileName, vbInformation
    End Sub
        
　
    
    ' フォルダ選択ダイアログを使用してフォルダパスを取得
    Function GetFolderPath() As String
    Dim folderDialog As FileDialog
    Dim selectedFolder As String
    
    ' フォルダ選択ダイアログを作成
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    With folderDialog
        .Title = "PDFファイルを検索するフォルダを選択してください"
        .AllowMultiSelect = False
        
        ' ダイアログを表示し、フォルダが選択されたかチェック
        If .Show = -1 Then
            selectedFolder = .SelectedItems(1)
        Else
            selectedFolder = ""
        End If
    End With
    
    ' 選択されたフォルダパスを返す
    GetFolderPath = selectedFolder
    End Function
　
    
    Function FindFile(folderPath As String, fileName As String) As String
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    Dim subFolder As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath)
    
    ' 現在のフォルダ内のファイルを検索
    For Each file In folder.Files
        If LCase(file.Name) = LCase(fileName) Then
            FindFile = file.Path
            Exit Function
        End If
    Next file
    
    ' サブフォルダを再帰的に検索
    For Each subFolder In folder.SubFolders
        FindFile = FindFile(subFolder.Path, fileName)
        If FindFile <> "" Then Exit Function
    Next subFolder
    
    ' ファイルが見つからない場合は空文字を返す
    FindFile = ""
    End Function