どうせ誰も読んでない( *゚∀゚)v―.o.oo

だれも読んでないと思って勝手なことを!

Excel VBAから指定フォルダ内のPDFファイルを複数選択し、それらをCubePDFでマージする

Sub MergePDFsUsingCubePDF()
Dim FolderPath As String
Dim FileList() As String
Dim i As Integer
Dim PDFFileName As String
Dim OutputFilePath As String

'指定フォルダを選択する
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "PDFファイルを含むフォルダを選択してください"
If .Show <> -1 Then Exit Sub
FolderPath = .SelectedItems(1)
End With

'指定フォルダ内のPDFファイルを取得する
FileList = GetFileList(FolderPath, "*.pdf")
If UBound(FileList) < 1 Then
MsgBox "指定されたフォルダ内にPDFファイルが見つかりませんでした。", vbExclamation
Exit Sub
End If

'出力ファイル名を指定する
PDFFileName = InputBox("出力するPDFファイル名を入力してください(拡張子は不要)", "出力ファイル名の入力")
If PDFFileName = "" Then
MsgBox "ファイル名が入力されていません。", vbExclamation
Exit Sub
End If
OutputFilePath = FolderPath & "\" & PDFFileName & ".pdf"

'CubePDFを起動してPDFファイルをマージする
Dim shell As Object
Set shell = CreateObject("WScript.Shell")
shell.Run "cubepdf -merge -output """ & OutputFilePath & """ """ & Join(FileList, """ """) & """", 1, True

'処理が完了した旨を表示する
MsgBox "PDFファイルのマージが完了しました。", vbInformation
End Sub

Function GetFileList(FolderPath As String, FileExtension As String) As String()
Dim FileList() As String
Dim FileName As String
Dim i As Integer

If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
FileName = Dir(FolderPath & FileExtension)
i = 0
Do While FileName <> ""
ReDim Preserve FileList(i)
FileList(i) = FolderPath & FileName
FileName = Dir()
i = i + 1
Loop
GetFileList = FileList
End Function

 

 

このコードは、指定されたフォルダ内のPDFファイルを取得し、CubePDFを使用してそれらをマージし、出力ファイルを指定されたフォルダに保存します。マージされたファイルの名前は、事前にユーザーに入力してもらいます。