質問番号:11162376606


http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q11162376606

下記のフォルダーにPDF形式の図面ファイルを入れてあります。
C:\Users\kojin\Desktop\製造工程\図面\123.pdf 等

これら図面をExcelVba にて印刷したいのですが
但しPDFファイルを開かず実行できるのがBestですが
印刷終了後はpdfを閉じるようにしたいと思っております。

どなたかご教授頂ければ助かります。


プログラム

Option Explicit

' レジストリ値取得用API
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
        (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
        ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
        (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
        lpType As Long, lpData As Any, lpcbData As Long) As Long

' レジストリ値取得用定数
Const KEY_QUERY_VALUE = &H1
Const HKEY_LOCAL_MACHINE = &H80000002

' PDF印刷用定数
Const PrintOK As Integer = 0
Const NoFile As Integer = -1
Const StatusNG As Integer = -2
Const AdobeReaderNG As Integer = -3


'概要 Yahoo知恵袋 質問番号:Q11162376606 2016.08.02

Sub Main()

Dim DirName As String
Dim FileName As String
Dim Res As Integer

'    DirName = "C:\Users\kojin\Desktop\製造工程\図面\"
'    FileName = "123.pdf"
    
    DirName = "Z:\"
    FileName = "sample.pdf"
    
    Res = PDFPrint(DirName, FileName)
    If Res = NoFile Then
        MsgBox "指定されたファイルは存在しません!", vbExclamation + vbOKOnly
    ElseIf Res = StatusNG Then
        MsgBox "通常使うプリンタのステータスが取得できません!", vbExclamation + vbOKOnly
    ElseIf Res = AdobeReaderNG Then
        MsgBox "Acrobat Readerがインストールされていません!", vbExclamation + vbOKOnly
    End If

End Sub


'概要 コマンドラインから指定されたPDFファイルを印刷する
'
'引数 DirName  : 印刷するPDFファイルのフォルダ名
'     FileName : 印刷するPDFファイル名
'
'返値 PrintOK (0)       : 正常終了
'     NoFile(-1)        : 指定されたPDFファイルが存在しない
'     StatusNG(-2)      : プリンタ名、ドライバ名、ポート名のいずれかの情報が取得できない
'     AdobeReaderNG(-3) : Adobe Readerがインストールされていない

Private Function PDFPrint(DirName As String, FileName As String) As Integer

Dim WSH As Object
Dim WExec As Object
Dim Path As String
Dim Result As String

Dim PrinterName As String
Dim DriverName As String
Dim PortName As String

Dim AdobeReaderInstallFolder As String
Dim CommandCode As String

Dim Tmp As Variant
Dim lp As Integer
   
    ' 指定されたPDFファイルが存在するか?
    If Right(DirName, 1) <> "\" Then
        DirName = DirName & "\"
    End If
    
    If Dir(DirName & FileName) = "" Then
        PDFPrint = NoFile
        Exit Function
    End If
    
    ' OSのバージョンチェック
    If InStr(Application.OperatingSystem, "5.01") > 0 Then
        Path = "C:\Windows\System32\"   ' WindowsXP
    Else
        Path = "C:\Windows\System32\Printing_Admin_Scripts\ja-JP\"      ' Windows Vista以上
    End If
    
    Set WSH = CreateObject("WScript.Shell")
    
    ' 通常使うプリンタ名取得
    Set WExec = WSH.exec("cscript " & Path & "prnmngr.vbs -g")
    
    Result = WExec.StdOut.ReadAll
    
    Tmp = Split(Result, vbCrLf)
    PrinterName = Split(Tmp(3), ": ")(1)

    ' ドライバ名・ポート名取得
    Set WExec = WSH.exec("cscript " & Path & "prnmngr.vbs -l")

    Result = WExec.StdOut.ReadAll

    Tmp = Split(Result, vbCrLf)

    lp = 0
    Do While UBound(Tmp) >= lp
        If InStr(Tmp(lp), "プリンター名 ") > 0 Then
            If InStr(Tmp(lp), PrinterName) > 0 Then
                DriverName = Replace(Tmp(lp + 2), "ドライバー名 ", "")
                PortName = Replace(Tmp(lp + 3), "ポート名 ", "")
                Exit Do
            End If
        End If
        lp = lp + 1
    Loop


    ' プリンタのステータスが取得できない
    If PrinterName = "" Or DriverName = "" Or PortName = "" Then
        Set WSH = Nothing
        Set WExec = Nothing
        PDFPrint = StatusNG
        Exit Function
    End If

    ' Acrobat Reader(Adobe Reader)のインストールパスをレジストリから取得
    AdobeReaderInstallFolder = GetRegValue(HKEY_LOCAL_MACHINE, _
        "SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe", "Path")
    
    If AdobeReaderInstallFolder = "" Then
        Set WSH = Nothing
        Set WExec = Nothing
        PDFPrint = AdobeReaderNG
        Exit Function
    End If

    ' PDFファイルを印刷
    CommandCode = AdobeReaderInstallFolder & "AcroRd32.exe /t " & DirName & FileName & " " & _
        Chr(34) & PrinterName & Chr(34) & " " & Chr(34) & DriverName & Chr(34) & " " & PortName
    Set WExec = WSH.exec(CommandCode)
    
    ' AdobeReaderを閉じる
    CommandCode = "taskkill /IM AcroRd32.exe"
    Set WExec = WSH.exec(CommandCode)
    
    Set WSH = Nothing
    Set WExec = Nothing
    PDFPrint = PrintOK

End Function


'概要 レジストリの値を取得する
'
'引数 lngRootKey : レジストリルートキー
'     strSubKey  : レジストリサブキー
'     strName    : 名前
'
'返値 取得したレジストリの値
'
'注釈 「EXCEL VBA:レジストリ情報取得・yuriのIT手帳」(http://blog.livedoor.jp/yorinaga/archives/52016032.html)参照

Function GetRegValue(lngRootKey As Long, strSubKey As String, strName As String) As String

    Dim lngRet As Long
    Dim hWnd As Long
    Dim strValue As String


    'ハンドルを開く
    hWnd = Application.hWnd

    lngRet = RegOpenKeyEx(lngRootKey, strSubKey, 0, KEY_QUERY_VALUE, hWnd)

    '受け取り値用のバッファを確保
    strValue = String(255, " ")

    '値を取得
    lngRet = RegQueryValueEx(hWnd, strName, 0, 0, ByVal strValue, LenB(strValue))

    'ハンドルを閉じる
    RegCloseKey hWnd

    '取得した値から後続のNullを取り除く
    strValue = Left(strValue, InStr(strValue, vbNullChar) - 1)

    '取得した値を返り値に設定
    GetRegValue = strValue

End Function

参考サイト

Windowsのバージョン情報取得

https://www.moug.net/tech/exvba/0150124.html
Windowsの種類を取得する・morg(モーグ

プリンタの情報(既定のプリンタ名、ドライバ名、ポート名)

http://www.town.yakumo.lg.jp/modules/information_blog/details.php?bid=871
プリンタの情報取得・北海道八雲町情報政策課ブログ

https://msdn.microsoft.com/ja-jp/library/cc772768(v=ws.10).aspx
Prnmngr.vbs・マイクロソフト

Prnmngr.vbs

プリンタまたはプリンタ接続を追加、削除、および一覧表示します。また、既定のプリンタを設定および表示します。パラメータを付けずに prnmngr.vbs を実行すると、prnmngr.vbs コマンドのコマンド ライン ヘルプが表示されます。

Adobe Readerのプロパティ取得及び印刷(Adobe Readerのインストールフォルダ)

https://helpx.adobe.com/jp/acrobat/kb/511265.html
レジストリから AcrobatAdobe Reader のバージョン情報を得る方法について(別解)・Adobe

http://pdf-file.nnn2.com/?p=222
WINDOWSコマンドラインから ACROBATADOBE READER を使用して印刷する方法・VBA(Excel)からAcrobat経由でPDFをプログラミング操作(OLE:IAC)する

http://blog.livedoor.jp/yorinaga/archives/52016032.html
EXCEL VBAレジストリ情報取得・yuriのIT手帳