PDFtkを利用してPDF分割

Option Explicit

' PDFtkのパスを指定
Const PDFTK_PATH = "C:\Program Files (x86)\PDFtk\bin\pdftk.exe"

' 分割対象のPDFファイルが格納されているフォルダのパスを指定
Dim inputFolder
inputFolder = "Z:\Work\【信頼できる場所_Excel】\分割前" ' ここを適切なフォルダのパスに変更

' 分割後のファイルを保存するフォルダのパスを指定
Dim outputFolder
outputFolder = "Z:\Work\【信頼できる場所_Excel】\分割後" ' ここを適切な出力フォルダのパスに変更

' 入力フォルダの存在確認
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(inputFolder) Then
    MsgBox "入力フォルダが存在しません: " & inputFolder, vbCritical
    WScript.Quit
End If

' 分割後のフォルダが存在しない場合は作成
If Not fso.FolderExists(outputFolder) Then
    fso.CreateFolder(outputFolder)
End If

' 分割するページを入力させる
Dim splitPage
splitPage = InputBox("どのページから分割しますか？", "ページ指定")

If IsNumeric(splitPage) = False Or CInt(splitPage) < 1 Then
    MsgBox "無効なページ番号です。", vbCritical
    WScript.Quit
End If

' フォルダ内の各PDFファイルに対して分割処理
Dim folder, file, outputPDF1, outputPDF2
Set folder = fso.GetFolder(inputFolder)

For Each file In folder.Files
    If LCase(fso.GetExtensionName(file.Name)) = "pdf" Then
        ' 入力ファイル名からベース名を取得
        Dim baseName
        baseName = fso.GetBaseName(file.Name)

        ' 出力ファイルのパスを指定（分割後フォルダに基づく）
        outputPDF1 = outputFolder & "\" & baseName & "_part1.pdf" ' 第一部分の出力パス
        outputPDF2 = outputFolder & "\" & baseName & "_part2.pdf" ' 第二部分の出力パス

        ' PDFを分割するコマンド
        Dim command1, command2
        command1 = """" & PDFTK_PATH & """ """ & file.Path & """ cat 1-" & splitPage & " output """ & outputPDF1 & """"
        command2 = """" & PDFTK_PATH & """ """ & file.Path & """ cat " & (CInt(splitPage) + 1) & "-end output """ & outputPDF2 & """"

        ' コマンドを実行
        Dim shell
        Set shell = CreateObject("WScript.Shell")

        ' 第一部分を分割
        Dim result1
        result1 = shell.Run(command1, 0, True)
        If result1 <> 0 Then
            MsgBox "ファイル " & file.Name & " の第一部分の分割に失敗しました。エラーコード: " & CStr(result1), vbCritical
        End If

        ' 第二部分を分割
        Dim result2
        result2 = shell.Run(command2, 0, True)
        If result2 <> 0 Then
            MsgBox "ファイル " & file.Name & " の第二部分の分割に失敗しました。エラーコード: " & CStr(result2), vbCritical
        End If

        ' 成功した場合のみメッセージを表示
        If result1 = 0 And result2 = 0 Then
            MsgBox "ファイル " & file.Name & " を分割しました。", vbInformation
        End If
    End If
Next

' 分割完了後、入力フォルダ内のすべてのPDFファイルを削除
For Each file In folder.Files
    If LCase(fso.GetExtensionName(file.Name)) = "pdf" Then
        fso.DeleteFile(file.Path
    End If
Next

MsgBox "すべてのPDFファイルの処理が完了しました。", vbInformation