WordVBAにて複数のPDFファイルをExcelファイル一覧表の順番通りに結合したい。

Question

###前提・実現したいこと
VBA初心者です。宜しくお願い致します。

WordVBAにてRTFファイルをPDF化した複数のファイルをExcelのファイル一覧表の並び
通りに結合したいです。
2つのPDFファイル結合は【pdftool.dll】
にて下記のコードでできるのですが、100ファイル以上を結合したいのです。

Public Declare Function CombinePDF Lib "pdftool.dll"
(ByVal PDF1 As Long, ByVal PDF2 As Long, ByVal SaveFileName As String) As Long

出来れば、VBAにてループ処理で行いたいです。

###該当のソースコード(2017/06/08追加しました)

' PDFDesigner Tools API
Public Declare Function LoadPDF Lib "pdftool.dll" (ByVal OpenFileName As String) As Long
Public Declare Sub FreePDF Lib "pdftool.dll" (ByVal PDF As Long)

Public Declare Function CombinePDF Lib "pdftool.dll" (ByVal PDF1 As Long, ByVal PDF2 As Long, ByVal SaveFileName As String) As Long

' PDFのバージョンを1.4形式にする(コピーしたファイルを編集)
Public Sub ChangePDFVersion(ByVal OpenFileName As String, ByVal SaveFileName As String)
Dim Stream() As Byte ' ストリーム
Dim FileNo As Integer ' ファイルNO

' ファイルを読み込む
FileNo = FreeFile
ReDim Stream(FileLen(OpenFileName) - 1)

Open OpenFileName For Binary As #FileNo
Get #FileNo, , Stream
Close #FileNo

' PDFの形式を1.4にする
Stream(5) = "&H31": Stream(7) = "&H34"

' ファイルの出力
FileNo = FreeFile
Open SaveFileName For Binary Access Write As #FileNo
Put #FileNo, , Stream
Close #FileNo
End Sub

'Excelを起動する
Set app = CreateObject("Excel.Application")

'abc.xlsを開く
Dim book As Excel.Workbook
Set book = app.Workbooks.Open("C:\Users\9A150\Desktop\PDF化\PDF一覧.xlsx")

For r = 2 To 4 '行を1から4まで
If Range("A" & r).Value <> "" Then 'A列注目行の値が""なら
mypdf = Range("C" & i + 1).Value

ChDir ThisDocument.Path 'Wordファイルと同じフォルダ
If mypdf <> "" Then
Documents.Open FileName:=mypdf
End If

PDF1 = mypdf

' 拡張子をtmpに変換する
tmp1 = Replace(PDF1, ".pdf", ".tmp", Compare:=vbTextCompare)
tmp2 = Replace(PDF2, ".pdf", ".tmp", Compare:=vbTextCompare)

' 元のPDFファイルをコピーしてバージョンを1.4形式に変更する
Call ChangePDFVersion(PDF1, tmp1)
Call ChangePDFVersion(PDF2, tmp2)

' PDFファイルを読み込んでハンドルを取得する
p1 = LoadPDF(tmp1)
p2 = LoadPDF(tmp2)

' PDFファイルを結合する
Result = CombinePDF(p1, p2, SaveFileName)

' PDFファイルのハンドルを解放する
FreePDF (p1)
FreePDF (p2)

###試したこと
Acrobatから結合するプログラムも検索して出てきたのですが
エラーになってしまい、使えませんでした。

###補足情報(言語/FW/ツール等のバージョンなど)
より詳細な情報

Word2010
Excel2010

Answer 1

既にExcel.Workbookを型として宣言していましたので、Excel Object Libralyは参照設定に追加いただいているものと思いますので、その前提で。
PDFの読み込み～加工部分に関しては環境がないのでそのまま動くものとして、Excelループ部分のみアドバイスさせていただきます。

セル値の参照

Excelのセル値を参照する場合、まずブックを開き、そのブックに含まれるワークシートを指定して、その中のセル座標を指定して値を参照します。
Workbook.Worksheets("シート名").Cells(行番号, 列番号)

なお、列番号の指定は通常は数値指定ですが、A列なら"A"などのアルファベット文字列でも指定できます。
プログラム的には数値指定の方が扱いやすいですが、見る人にはアルファベット指定の方がやさしいかもしれません。
状況によって使い分けてください。

また、セルの参照にRangeを使う人も多いですが、セル範囲ではなく単一セルを扱う場合にはCells(row, col)のほうが扱いやすいと思います。

ループ範囲

コード中のループ範囲は２～４行で作成しかけているようですが、おそらく本来はA列で値が入力されている範囲をループしたいのではないかと推測します。

A列のデータがある最終行を探す方法は、Excel上での操作だとA列に入力可能な最下行(Excel2010では1048576行目)からCtrl+↑を押すことで特定できます。
これをVBA的に記述するとCells(Rows.Count, "A").End(xlUp)という記述になります。

これで見つけたセルの行までループしてあげればいいと思います。

以下、サンプルです。

Sub test()

    'Excelを起動する
    Set app = CreateObject("Excel.Application")
    
    'abc.xlsを開く
    Dim book As Excel.Workbook
    Set book = app.Workbooks.Open("C:\Users\9A150\Desktop\PDF化\PDF一覧.xlsx")
    
    'ファイル名一覧シートを指定
    Dim sht As Excel.Worksheet
    Set sht = book.Sheets("Sheet1")
    
    For r = 2 To sht.Cells(Excel.Rows.Count, "A").End(xlUp).Row     '行を2から最終行まで
    
        If sht.Cells(r, "A").Value <> "" Then 'A列注目行の値が""でなければ
        
            'C列からファイル名を取得する
            mypdf = sht.Cells(r, "C").Value
            
            ChDir ThisDocument.Path  'Wordファイルと同じフォルダ
            If mypdf <> "" Then
                Documents.Open FileName:=mypdf
            End If
            
            PDF1 = mypdf
            
            ' 拡張子をtmpに変換する
            tmp1 = Replace(PDF1, ".pdf", ".tmp", Compare:=vbTextCompare)
            tmp2 = Replace(PDF2, ".pdf", ".tmp", Compare:=vbTextCompare)
            
            ' 元のPDFファイルをコピーしてバージョンを1.4形式に変更する
            Call ChangePDFVersion(PDF1, tmp1)
            Call ChangePDFVersion(PDF2, tmp2)

            ' PDFファイルを読み込んでハンドルを取得する
            p1 = LoadPDF(tmp1)
            p2 = LoadPDF(tmp2)

            ' PDFファイルを結合する
            Result = CombinePDF(p1, p2, SaveFileName)

            ' PDFファイルのハンドルを解放する
            FreePDF (p1)
            FreePDF (p2)
            
        End If
    Next

End Sub

コメントを受けて追記

やりたいこととしては、
①ファイル１を取得
②ファイル２を取得してファイル１に結合　⇒結合ファイルが作成される
③ファイル３を取得して前回の結合ファイルに結合　⇒結合ファイルが更新される
というかんじであっていますでしょうか？

上記であれば、プログラムでも
①ループ１周目：ファイル１を取得
②ループ２周目：ファイル２を取得してファイル１に結合　⇒結合ファイルを作成する
③ループ３周目以降：ファイル３を取得して前回の結合ファイルに結合　⇒結合ファイルが更新される
というように１ファイル目・２ファイル目と３ファイル目以降でPDF取得処理を分岐してあげることで実現できそうな気がします。
（PDF加工の部分がブラックボックスなので断言はできませんが。）

以下、修正したサンプルです。

Sub test2()
    'Excelを起動する
    Set app = CreateObject("Excel.Application")

    'abc.xlsを開く
    Dim book As Excel.Workbook
    Set book = app.Workbooks.Open("C:\Users\9A150\Desktop\PDF化\PDF一覧.xlsx")

    'ファイル名一覧シートを指定
    Dim sht As Excel.Worksheet
    Set sht = book.Sheets("Sheet1")

    Dim AddCnt As Integer
    AddCnt = 0
    
    For r = 2 To sht.Cells(sht.Rows.Count, "A").End(xlUp).Row     '行を2から最終行まで
        
        If sht.Cells(r, "A").Value <> "" Then 'A列注目行の値が""でなければ
            
            'C列からファイル名を取得する
            mypdf = sht.Cells(r, "C").Value
            
            ChDir ThisDocument.Path  'Wordファイルと同じフォルダ
            
            If mypdf <> "" Then
                Documents.Open FileName:=mypdf
                'カウンタ＋１
                AddCnt = AddCnt + 1
                
                If AddCnt = 1 Then
                    '１ファイル目の場合
                    ' PDFファイルを読み込んでハンドルを取得する
                    p1 = MakeTemp(mypdf)
                ElseIf AddCnt = 2 Then
                    '２ファイル目の場合
                    ' PDFファイルを読み込んでハンドルを取得する
                    p2 = MakeTemp(mypdf)
                    ' PDFファイルを結合する
                    Result = CombinePDF(p1, p2, SaveFileName)
                    ' 結合したPDFファイルのハンドルを解放する
                    FreePDF (p1)
                    FreePDF (p2)
                    
                    '次回のベースファイルとして結果PDFをオープン
                    p1 = MakeTemp(SaveFileName)
                    
                Else
                    '３ファイル目以降の場合
                    ' PDFファイルを読み込んでハンドルを取得する
                    p2 = MakeTemp(mypdf)
                    ' PDFファイルを結合する
                    Result = CombinePDF(p1, p2, SaveFileName)
                    ' 結合したPDFファイルのハンドルを解放する
                    FreePDF (p2)
                    
                End If
                
            End If
        End If
    Next
    ' 結果PDFファイルのハンドルを解放する
    FreePDF (p1)
    
    'ブックを閉じる
    book.Close
    
End Sub

'tmp作成～PDF読込
Function MakeTemp(ByVal vsPDF As String) As Long
    
    Dim p As Long
    p = 0
    
    ' 拡張子をtmpに変換する
    tmp = Replace(vsPDF, ".pdf", ".tmp", Compare:=vbTextCompare)
    
    ' 元のPDFファイルをコピーしてバージョンを1.4形式に変更する
    Call ChangePDFVersion(vsPDF, tmp)
    
    ' PDFファイルを読み込んでハンドルを取得する
    p = LoadPDF(tmp)
    
    MakeTemp = p

End Function

※tmpの作成～PDF読込の部分は、複数個所で繰り返し使用しているため関数にしました。

Comments

[Goebo]

とても丁寧な回答有難うございます。
大変恐縮ですが私の書き方が悪く。。
現状複数のPDFの結合がExcelのLoopで出来たらと考えてました。
ですが、Excelのループだけでは難しいみたいです。

2つのPDFファイル結合は【pdftool.dll】
Public Declare Function CombinePDF Lib "pdftool.dll"
(ByVal PDF1 As Long, ByVal PDF2 As Long, ByVal SaveFileName As String) As Long

' PDFファイルを結合する
Result = CombinePDF(p1, p2, SaveFileName)
上記で2つのファイルは結合できるのですが、複数なのでp2を
ループにと考えてました。
ですが、Excelのプログラムの書き方の勉強にもなり感謝しております。

[jawa]

>Excelのループだけでは難しいみたいです。
この部分の意味がよくわからなかったのですが、WordではなくExcel側のVBAでループ処理するということではないですよね？
それではWordは関係ないことになってしまうので。。

仮に上記であったとしても、Excelからpdftool.dllが利用できるのであればやることは大して変わらない（むしろシンプルになりそう）のでできないことはない気がします。

とりあえず「WordのVBAでExcelを開いてループする」という部分は崩さずに回答追記させていただきました。
参考になれば幸いです。

[Goebo]

やりたいことに関して正にその通りです。
申し訳ありません、WordVBAです。
丸投げで誠に申し訳ありませんが、PDFのバージョン変更のPGが
間違っているようです。。
とても分かりやすい回答を頂き感謝しております。
もう少しあぐねてみます。

[jawa]

>PDFのバージョン変更のPGが間違っているようです。
MakeTmp関数がうまく動いていないということでしょうか？

もしかすると結合結果のPDFを毎回解放していないのが原因かもしれません。
ループ３週目以降はPDF1を解放せずループ終了後に解放していますが、これをPDF2の解放と同じタイミングで解放してあげてはどうでしょうか？

PDF加工の部分は環境がなく動作確認が取れていませんので、すみませんがご確認お願いします。

[Goebo]

違います。
該当ソースコードに追加した部分の
【ChangePDFVersion】PGです。
PDF変換PGを再度確認してみます。
お手間を取らせて申し訳ありませんでした。

[jawa]

変換処理のコード自体は配布元サイトでVBAサンプルとして紹介されている内容(http://www.petitmonte.com/excel/excel_tips_8.html)そのままのようですので、問題なさそうに見えます。

試しにこちらでもpdftool.dllを使って動かしてみましたが、私の環境(Windows7/Office2010/32bit)ではWordで作成した４つのPDFファイルを期待通り連結することができました。

上記サイトによると、32bit/64bitの違いや、暗号化されているなど対応できないPDFファイルも存在するようです。
そういった類の問題だとこのツールでの連結は難しいかもしれませんね。。

[Goebo]

度々誠に申し訳ありません。
jawa様の修正したPGで4つのPDF連結出来たのでしょうか。
【ChangePDFVersion】PGの部分で[ファイルが見つかりません]と出てしまいます。。
32bitのWordで、暗号化もされていないPDFです。

[jawa]

こちらでは紹介した2つ目のソースで動作確認し、問題なく連結できましたよ。

ファイルが見つからないということは、ファイルをOpenしている部分でこけているようですね。

以下のあたりを再確認してみてはどうでしょうか？
・ファイル名はExcelの一覧表から取得していると思いますが、フォルダ名も含めてフルパスで指定されているか？
　⇒ファイル名がフルパスで記述されていなければフルパスで記述する。
　もしくは取得したファイル名にVBA側でフォルダ名をつけたす。

・指定されているなら、その場所に正しくファイルが置かれているか？
　⇒Excelに記述されているファイルが本当にその場所にあるか確認する

・そもそも一覧からファイル名を正しく取得できているか？
　⇒ファイル名を取得した後にメッセージボックスなどで取得内容を表示して確認する

[Goebo]

ご丁寧に誠にありがとうございます!
今度は書き込みが出来ませんのエラーメッセージが下記のPGで起きます。。
[SaveFileName]には、tmpファイルが格納されてます。

====================================
Open SaveFileName For Binary Access Write As #FileNo
Put #FileNo, , Stream　　　↑↑↑ここで書き込みができませんとエラー
Close #FileNo
==============================================

' PDFのバージョンを1.4形式にする(コピーしたファイルを編集)
Public Sub ChangePDFVersion(ByVal OpenFileName As String, ByVal SaveFileName As String)
Dim Stream() As Byte ' ストリーム
Dim FileNo As Integer ' ファイルNO

' ファイルを読み込む
FileNo = FreeFile
ReDim Stream(FileLen(OpenFileName) - 1)

Open OpenFileName For Binary As #FileNo
Get #FileNo, , Stream
Close #FileNo

' PDFの形式を1.4にする
Stream(5) = "&H31": Stream(7) = "&H34"

' ファイルの出力
FileNo = FreeFile
Open SaveFileName For Binary Access Write As #FileNo
Put #FileNo, , Stream　　　↑↑↑ここで書き込みができませんとエラー
Close #FileNo
End Sub

[jawa]

読込はできたけど書き込みができないということですね。

ここらの処理はまだpdftool.dllを利用するところまでいっておらず、普通にファイルを開いてその一部(PDFバージョン情報)を書き換えて別ファイルとして保存する、ということしかしていません。

１つも結合できずにエラーが発生するのか、途中まで結合できているけど途中でエラーになるのかにもよりますが、前者であれば出力しようとしているファイルのパスとか、環境面の問題だと思います。

・出力ファイルのパスが正しいか？
・出力しようとしているフォルダへの書き込み権限があるか？
・出力ファイルを他で開いていないか？

といったあたりを確認してみてください。

後者であれば出力ファイルを毎回解放していない部分が問題となっているのかもしれません。

[Goebo]

返信ありがとうございます。
遅れて申し訳ありません。
【ファイルが見つかりません】のエラーが出てしまいます。。
tmpファイルが開いた状態になってしまいます。。
1つも結合できずにエラーが発生します。
私の知識では難しい様なので、他の方法を探してみます。
とても丁寧な回答誠にありがとうございました。

[jawa]

解決に至らなかったようで、残念です。力及ばず申し訳ありません。

どうもファイルの入出力のあたりで躓いているようですね。
うまく動かないときはうまく動かない原因を把握し、解消する必要があります。
その際、原因を探しやすくするという意味で、いきなり最終目標の環境でテストするのではなく、簡単なテスト環境で動作確認してみるのもいかもしれません。
今回であればテスト用フォルダを作成し、１ページくらいのテスト用PDFファイルを２～３個連結してみる、といった具合です。
時間が許すようであればお試しください。

またプログラムが思ったような動作をしているか、デバッグ実行したり、ログを出したり、メッセージ表示などして確認するのも一つの手です。
・ファイルが開けない、というときにどんなファイルパスをオープンしようとしているのか？
・ファイルが書き込めない、というときにどんなファイルパスに出力しようとしているのか？

以下はこちらでテストした際の環境と手順です。参考になれば幸いです。
＝＝＝
動作環境：Windows7(32bit)/Office2010

手順：
①WordでPDFファイルを作成。
C:\Tera\Test01.pdf
C:\Tera\Test02.pdf
C:\Tera\Test03.pdf
C:\Tera\Test04.pdf

②ファイル一覧取得用のExcelを作成。
⇒①で作成したPDF（４ファイル）のパスをC列２～５行目に記述。
C:\Tera\Test09.xls

③マクロを実行するWordファイルを作成
C:\Tera\Test09.doc

④マクロを実行（SaveFileNameはC:\Tera\Result.pdf）

という手順で確認しました。

使用したプログラムは以下のものです。
マクロを実行するWordファイルの末尾にログを出力するよう少しいじってあります。
＝＝＝
Sub test2()

log "==========" 'debug

Dim SaveFileName As String
SaveFileName = "c:\tera\Result.PDF"
'Excelを起動する
Set app = CreateObject("Excel.Application")

'abc.xlsを開く
Dim book As Excel.Workbook
' Set book = app.Workbooks.Open("C:\Users\9A150\Desktop\PDF化\PDF一覧.xlsx")
Set book = app.Workbooks.Open("C:\tera\test09.xls")

'ファイル名一覧シートを指定
Dim sht As Excel.Worksheet
Set sht = book.Sheets("Sheet1")

Dim AddCnt As Integer
AddCnt = 0

For r = 2 To sht.Cells(sht.Rows.Count, "A").End(xlUp).Row '行を2から最終行まで

If sht.Cells(r, "A").Value <> "" Then 'A列注目行の値が""でなければ

'C列からファイル名を取得する
mypdf = sht.Cells(r, "C").Value

ChDir ThisDocument.Path 'Wordファイルと同じフォルダ

If mypdf <> "" Then
'Documents.Open FileName:=mypdf '連結するだけなら開く必要はない
'カウンタ＋１
AddCnt = AddCnt + 1

If AddCnt = 1 Then

log "PDF1:" & mypdf 'debug

'１ファイル目の場合
' PDFファイルを読み込んでハンドルを取得する
p1 = MakeTemp(mypdf)

ElseIf AddCnt = 2 Then

log "PDF2:" & mypdf 'debug

'２ファイル目の場合
' PDFファイルを読み込んでハンドルを取得する
p2 = MakeTemp(mypdf)
' PDFファイルを結合する
Result = CombinePDF(p1, p2, SaveFileName)

log "COMB:" & SaveFileName 'debug

' 結合したPDFファイルのハンドルを解放する
FreePDF (p1)
FreePDF (p2)

Else

log "PDF1:" & SaveFileName 'debug

'３ファイル目以降の場合
'次回のベースファイルとして結果PDFをオープン
p1 = MakeTemp(SaveFileName)

log "PDF2:" & mypdf 'debug

' PDFファイルを読み込んでハンドルを取得する
p2 = MakeTemp(mypdf)
' PDFファイルを結合する
Result = CombinePDF(p1, p2, SaveFileName)

log "COMB:" & SaveFileName 'debug

' 結合したPDFファイルのハンドルを解放する
FreePDF (p1) 'p1も毎回解放しないと最後のファイルしか連結されませんでした。
FreePDF (p2)

End If

End If
End If
Next

'ブックを閉じる
book.Close

End Sub

Function MakeTemp(ByVal vsPDF As String) As Long

Dim p As Long
p = 0

' 拡張子をtmpに変換する
tmp = Replace(vsPDF, ".pdf", ".tmp", Compare:=vbTextCompare)

log " tmp:" & tmp 'debug

' 元のPDFファイルをコピーしてバージョンを1.4形式に変更する
Call ChangePDFVersion(vsPDF, tmp)

' PDFファイルを読み込んでハンドルを取得する
p = LoadPDF(tmp)

MakeTemp = p

End Function

Sub log(vMsg As String)
'Word文書の最後に文字列を出力する
Bookmarks("\EndOfDoc").Range.InsertAfter Text:=vMsg & vbCrLf
End Sub
＝＝＝

以上、長文失礼しました。

[Goebo]

本当にありがとうございます!!
本日中には提出したかったので、PDFにて結合ではなく
RTFのファイルで結合しPDFに変換としました。
とても丁寧に書いて頂いたPGで、明日以降テストを行います。
また、最初に教えて頂いたExcelVBAのループがRTFファイル結合のPG
を書くときに役立ちました。
まだまだ頑張らなくては駄目な中、本当にありがとうございました。
今後とも宜しくお願い致します。