フォルダ内のpdfを一括印刷

Sub フォルダ内PDFファイル一括印刷()

Dim strPath As String
Dim strFileName As String
Dim pdffiles() As String
Dim intcount As Integer

‘変数strPathに、フォルダのパスを格納
strPath = “C:\Documents and Settings\isa\デスクトップ\問題集\”

‘変数strFileNameに、フォルダ内のファイル名を格納
strFileName = Dir(strPath)

‘フォルダ内のファイルがなくなるまでLoop
Do Until Len(strFileName) = 0
   
    ‘ファイル名の右から3文字が”pdf”かどうか判別   
 If Right(strFileName, 3) = “pdf” Then
       
        ‘pdffilesにその時のファイル名を取得し配列として格納
        ReDim Preserve pdffiles(intcount)
        pdffiles(intcount) = strFileName
       
        ‘pdffiles(0)・pdffiles(1)というようにファイルの数だけ
       ‘配列のインデックス番号が増えて管理できるようにするため+1する
        intcount = intcount + 1
       
    End If
   
    ‘一度Dir関数で取得されたファイルは取得されないようにする処理
    strFileName = Dir()

Loop

‘——————————————
‘ここまでの処理でpdffilesという配列には
‘ファイルの数だけ配列が出来上がっている状態
‘——————————————
‘——————————————
‘ここから下はpdffilesという配列に入っている
‘ファイルを順番に印刷をかける処理
‘——————————————
Dim AcroExchApp As Object
Dim AcroExchPDDoc As Object
Dim AcroExchAvDoc As Object
Dim buf As Long

Set AcroExchApp = CreateObject(”AcroExch.APP”)
Set AcroExchPDDoc = CreateObject(”AcroExch.PDDoc”)
Set AcroExchAvDoc = CreateObject(”AcroExch.AVDoc”)

buf = AcroExchApp.Show

Dim i As Integer

    For i = 0 To UBound(pdffiles)
        buf = AcroExchAvDoc.Open(strPath & pdffiles(i), “”)
        Set AcroExchPDDoc = AcroExchAvDoc.GetPDDoc()

        ‘開いたPDFファイルのページ数をnumPageに格納
        Dim numPage As Long
            numPage = AcroExchPDDoc.GetNumPages
           
            ‘PrintPagesで印刷をかける
            ‘プリンタはデフォルトのプリンタで、印刷のダイアログボックスは
            ‘表示されない
            ‘以下のステートメントは開いたPDFファイルの
            ‘最初のページから最後のページまでを印刷をかけるもの
            ‘また戻り値は「-1」ならうまく機能している
            ‘「-1」以外はPDFファイルが開いていないときに返される戻り値
            buf = AcroExchAvDoc.PrintPages(0, numPage - 1, 2, 0, 0)
       
            ‘一行上のステートメントで「-1」以外の戻り値の場合は
            ‘ファイルが開かれていないときにおきるので
            ‘変数bufが「-1」以外だったら印刷失敗というメッセージを出すようにしている
            If buf <> -1 Then
                MsgBox (”印刷に失敗しました。ファイルが開かれていない可能性があります”)
            Exit Sub
       
        End If
       
        buf = AcroExchAvDoc.Close(False)
    Next

buf = AcroExchApp.Exit

Set AcroExchApp = Nothing
Set AcroExchPDDoc = Nothing
Set AcroExchAvDoc = Nothing

End Sub