[[20150314100926]]　『vbaでpdfやxdwの印刷について』（スズメ）　ページの最後に飛ぶ

『vbaでpdfやxdwの印刷について』（スズメ）

参考サイト
http://www.excel.studio-kazu.jp/kw/20081023153339.html
http://www.excel.studio-kazu.jp/kw/20140530132945.html

これを参考に、xdwやpdfの印刷を試みたのですが、自分のパソコンの一定のユーザー上では印刷ができません。

コードは以下の通りです。

Sub main()

    Dim fso As Object
    Dim ff As Object
    Dim ffi As Object
    Dim veb As Object
    With CreateObject("Shell.Application")
       Set ff = .Namespace("対象のフォルダのパス")
    End With
    Set fso = CreateObject("scripting.filesystemobject")
    For Each ffi In ff.items
       If ffi.IsFileSystem And (Not ffi.IsFolder) _
          And LCase(fso.GetExtensionName(ffi.Name)) = "pdf" Then←ここでつまずく
             For Each veb In ffi.Verbs
    If veb.Name = "印刷(&P)" Then
        veb.doit
        Exit For
    End If
 Next

             End If
       Next
    Set ffi = Nothing
    Set ff = Nothing
 End Sub

うまくファイルシステムオブジェクトが動かないようです。私のパソコンの場合、ユーザーアカウントが4つあり、一つ目と三つ目が動き、二つ目と四つ目が動きません。そのうち、管理者権限は一つ目以外すべてにあるので管理者権限は関係ありません。また、共有設定を確認しても、全てのユーザーにフルコントロールの権限があるので共有設定が問題ではなさそうです。ウイルス対策ソフトを疑いましたが、これではユーザーによって印刷できるかできないかの説明がつきません。

わかるかたいましたら教えて下さい。よろしくお願いします。

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 共有設定ということは、ファイルはPC外にあるのでしょうか。
 その場合、ファイルは通常のフォルダ表示で見えていますか。

 あるいは、同一端末であれば OS、EXCEL は同じ環境だと思いますが、フォルダオプション
 なども同じになっているでしょうか。

 設定を変更（リセット？）しても良いのであれば、動くユーザのユーザプロファイルを
 動かないユーザにコピーするなどの手もありますが、各ユーザがいろいろと設定を変更して
 使用しているでしょうか。
（Mook） 2015/03/14(土) 12:14

ファイルはPC内にあります。
フォルダやファイルの設定は、あるユーザーが設定を変更すると、ほかのユーザーの設定まで変更されるので、ユーザーごとに設定が違うことはありません。例えば、一つ目のユーザーが二つ目のユーザーがファイルをフルコントロールできるように設定を変更すれば、その設定は二つ目のユーザーでパソコンを操作している時にも反映されます。

ユーザーの設定は、コントロールパネルをみても、管理者権限にするか、標準ユーザーにするかという設定と、保護者によるパスワードの設定くらいしか見当たりません。保護者によるパスワードの設定はしていません。

ほかにユーザーに関する設定は存在するのでしょうか？
（スズメ） 2015/03/14(土) 14:41

あと、参考になるかもしれないので、付け足しておきます。このコードを会社でもやりましたが、できませんでした。もちろん、会社では私は管理者権限を持っておりません。
（スズメ） 2015/03/14(土) 14:45

 >       Set ff = .Namespace("対象のフォルダのパス")

　この内容　"対象のフォルダのパス"　ここの実際のパス名ですが、

 例えば、　　c:\aaa\bbb だとしたら、このまま　c:\aaa\bbb　と指定するのではなく、

             c:\aaa\bbb\      と指定してみるとどうなりますか？

 又は、

 dim pp as string
 pp="c:\aaa\bbb"
 ・
 ・
 Set ff = .Namespace((pp))

 これで結果に変化がありますか？

（ichinose） 2015/03/14(土) 15:52

何も変化がありませんでした。
あと、もう一つ付け足しておきます。上記のコードを実行してつまずくとき、エラーは出ません。しかもつまずく場所で何の警告やエラーもなく勝手にマクロが終了します。
（スズメ） 2015/03/14(土) 17:50

 フォルダオプションで「登録されてる拡張子は表示しない」にチェックがはいっていませんか？

（マナ） 2015/03/14(土) 18:33

 私の環境（Excel2010　Win7）で作動しているコードを二つ提示しますので　これを試してください。

 新規ブックの標準モジュールに

 '====================================================================================
 Sub test1()
    Dim fpath As Variant
    fpath = Application.GetOpenFilename("すべてのファイル,*.*")
    If TypeName(fpath) <> "Boolean" Then
       If file_invorke(fpath, "印刷(&P)") <> 0 Then MsgBox "失敗"
    End If
 End Sub
 Function file_invorke(ByVal flpath As String, Optional exec As Variant = "開く(&O)") As Long
    Dim path As String
    Dim fnm As String
    Dim fobj As Object
    Dim v As Object
    On Error Resume Next
    With CreateObject("scripting.filesystemobject")
       path = .GetParentFolderName(flpath)
       fnm = .GetFileName(flpath)
    End With
    With CreateObject("Shell.Application").Namespace((path))
       Set fobj = .ParseName((fnm))
       For Each v In fobj.Verbs
          If v.Name = exec Then
             v.doit
             Exit For
          End If
       Next
      file_invorke = Err.Number
    End With
    On Error GoTo 0
 End Function
 Sub test2()
    Dim fpath As Variant
    fpath = Application.GetOpenFilename("すべてのファイル,*.*")
    If TypeName(fpath) <> "Boolean" Then
       If file_invorke2(fpath, "Print") <> 0 Then MsgBox "失敗"
    End If
 End Sub
 Function file_invorke2(ByVal flpath As String, Optional exec As Variant = "Open") As Long
    Dim path As String
    Dim fnm As String
    Dim fobj As Object
    Dim v As Object
    On Error Resume Next
    With CreateObject("scripting.filesystemobject")
       path = .GetParentFolderName(flpath)
       fnm = .GetFileName(flpath)
    End With
    With CreateObject("Shell.Application").Namespace((path))
       Set fobj = .ParseName((fnm))
       fobj.InvokeVerbEx (exec)
       file_invorke2 = Err.Number
    End With
    On Error GoTo 0
 End Function

 このtest1,test2です。どちらも　ファイル選択ダイアログが表示されますから、印刷したいファイルを選択してください。

 ＯＫボタンクリックしてください。私の環境では、どちらも印刷が可能です。

（ichinose） 2015/03/14(土) 19:19 (マナさん、ご指摘で修正）

登録されている拡張子は表示しないのチェックを外したところ、無事に印刷できました。Mookさん、ichinoseさん、マナさん、どうもありがとうございました。確かに、一つ目のユーザーと三つ目のユーザーは拡張子を表示しており、二つ目のユーザーと四つ目のユーザーは拡張子を表示していませんでした。多分、私の記憶では、会社のパソコンも拡張子を表示していない設定だったと思います。
（スズメ） 2015/03/14(土) 19:49

ffi.Nameをffi.pathにしたらどうなりますか？

（マナ） 2015/03/14(土) 19:56

 あとあてずっぽうですけれど、エラーもないということは、アプリケーションが
 インストールされていない（認識されていない）ということはないでしょうか。

 私の環境は拡張子を表示していますが、xdw 拡張子のファイル（DocWorks?）では、
 提示のコードで印刷されませんでした。
 （ソフト入れていないので、verbs に 印刷 コマンドがないからかな？）

 拡張子以外に印刷されるユーザとされないユーザでは、ファイルを右クリックしたときに、
 「印刷(&P)」というメニューが表示されて「いる・いない」の違いはないでしょうか。
（Mook） 2015/03/14(土) 20:20

私はまだNamespaceをマスターしきっていないので、推論でしか言えませんが、pathはダメだと思います。ffi.name はファイルの名前を表していると思うので、ファイルの名前からフォーマットを検出しろということだと思います。なので、ファイルのパスだとおかしなことになるのではないのでしょうか？ただ、運が良ければパス名でもフォーマットを抽出してくれる可能性は否定できません。今回、ファイル名に拡張子を表示しないと印刷できなかったのも、ファイルシステムオブジェクトがファイルの属性からフォーマットを検出するのではなく、ファイルの名前から検出するのが原因と思われます。
（スズメ） 2015/03/14(土) 20:46

アプリケーションに関することですが、会社でdwg(autocadの拡張子)の印刷を印刷(P)でautocadなしで試みたことがあります。しかし、印刷(P)がなかったので、手動で印刷できませんでしたので、やはりアプリケーションがないと印刷できないと思います。
（スズメ） 2015/03/14(土) 20:51

私は、xdwの印刷はこれからするつもりなので、今回はpdfでマクロを実行しましたが、私の自宅のパソコンにはAdobeReaderがインストールされているので、アプリが認識されていないわけではないと思います。
（スズメ） 2015/03/14(土) 20:59

 >推論でしか言えませんが、pathはダメだと思います。

 ごめんなさい。私も詳しくないもので。
 ↓ここみると、いけるかなと思いました。
 　
https://msdn.microsoft.com/ja-jp/library/windows/desktop/bb787810%28v=vs.85%29.aspx

（マナ） 2015/03/14(土) 21:07

 拡張子を非表示にしたことが原因ならば、　　その場合、ffi.nameで拡張子が格納されていないので

  LCase(fso.GetExtensionName(ffi.Name)) = "pdf"  この条件がTrueにならないので印刷はされません。

 LCase(fso.GetExtensionName(ffi.Path)) = "pdf"  にすると　pdfファイルなら　Trueになるので
 印刷されるのではないですか？

 問題は、

 Set ff = .Namespace("d:\aaa\bbb")

 上記のように　直接ここにフォルダパスを入れるのなら、大きい問題はないのですが、

 ここにパスを直接入力したのでは　フォルダに変更があったら、その都度　変更することになります。

 普通は、

 Set ff = .Namespace(ppath)

 このように　変数に入れて処理させるのではないですか？

 その時、一工夫しないとFolderオブジェクトが取得できません。

 確認してください

（ichinose） 2015/03/14(土) 22:01

 ＞その時、一工夫しないとFolderオブジェクトが取得できません。

 以前、稲葉さん（だったと思う）が、苦労されていた記憶がありますが、引数を（）に入れることでしょうか？

 追記）
 ichinoseさんの２つめので、file_invorke2がcopyfile2 となっています

（マナ） 2015/03/14(土) 22:28

 >引数を（）に入れることでしょうか？

 （pp)という実態を引数として　送るということです。

 引数を　()でくくるということではないです。

 Set ff = .Namespace("d:\aaa\bbb")  これで正常に作動する　ということは、

 値渡しで送らなければならないのでしょうね！！　ShellなどのWSHって、元々　VBSで使われることが
 目的に作られていますから、変数の指定に注意が必要ですね
 (と言っても以前は、正常に作動していましたけど）
 変数の型をきちんと指定すると　作動しない　という事象を経験したこともあります
 (この場合は　Variant型にしたら作動しました）。

 >file_invorke2がcopyfile2 となっています

 失礼しました。file_invorke2に修正します。

 ちょっとまえにコピーの質問があったときに　作ったのですが、
 どうせなら　処理は　パラメータで送ろうと変えたのですが、ミスがありました。

（ichinose） 2015/03/14(土) 22:51

 ちょっと撤回です。

 Set ff = .Namespace(ppath)
 このppathは、Variant型にすれば、正常に作動します。

 但し、

 fobj.InvokeVerbEx (exec)

 ここだけは、execという変数をVariant型にしただけでは、ダメでした。

（　ichinose） 2015/03/14(土) 23:22

 ありがとうございます。
 でも、ごめんなさい、まだ理解できていません。

 ＞fobj.InvokeVerbEx (exec)
 ＞ここだけは、execという変数をVariant型にしただけでは、ダメでした

 確認しようと、ichinoseさんやスズメさんのコードをいじったりしましたが
 エラーになりません。
 ↓のコードでも、エラーになってくれないのですが、どこが間違っているのでしょうか？

 Sub test()
    Dim fobj As Object

    Dim flpath 'As String
    flpath = "C:\******\***

    Dim fnm As String
    fnm = "******.pdf"

    Dim exec As String
    exec = "open"

    With CreateObject("Shell.Application").Namespace(flpath)
'    With CreateObject("Shell.Application").Namespace((flpath))

        On Error Resume Next

        Set fobj = .ParseName(fnm)
        If Err.Number <> 0 Then MsgBox "失敗1"

        fobj.InvokeVerbEx (exec)
        If Err.Number <> 0 Then MsgBox "失敗2"

        On Error GoTo 0

    End With

 End Sub

（マナ） 2015/03/15(日) 14:37

 >エラーになってくれないのです

 エラーになるというより、不具合例です。
 コード内にある
 D:\F\excel2010\book1.pdf   は、実際に存在するファイルです。

 Sub test1()
    Dim fobj As Object
    Dim flpath As String
    flpath = "D:\F\excel2010"
    Dim fnm As String
    fnm = "book1.pdf"
    Dim exec As String
    exec = "Print"
    With CreateObject("Shell.Application").Namespace(flpath)
        On Error Resume Next
        Set fobj = .ParseName(fnm)
        If Err.Number <> 0 Then MsgBox "失敗1"
        fobj.InvokeVerbEx (exec)
        If Err.Number <> 0 Then MsgBox "失敗2"
        On Error GoTo 0
    End With
 End Sub

 これは、「失敗1」というエラーメッセージが表示されます。

 Sub test2()
    Dim fobj As Object
    Dim flpath As Variant
    flpath = "D:\F\excel2010"
    Dim fnm As String
    fnm = "book1.pdf"
    Dim exec As String
    exec = "Print"
    With CreateObject("Shell.Application").Namespace(flpath)
        On Error Resume Next
        Set fobj = .ParseName(fnm)
        If Err.Number <> 0 Then MsgBox "失敗1"
        fobj.InvokeVerbEx exec
        If Err.Number <> 0 Then MsgBox "失敗2"
        On Error GoTo 0
    End With
 End Sub

 これは、エラーは発生しませんが、BOOK1.PDFは印刷されません、代わりに開いてしまいます。

 Sub test3()
    Dim fobj As Object
    Dim flpath As Variant
    flpath = "D:\F\excel2010"
    Dim fnm As String
    fnm = "book1.pdf"
    Dim exec As Variant
    exec = "Print"
    With CreateObject("Shell.Application").Namespace(flpath)
        On Error Resume Next
        Set fobj = .ParseName(fnm)
        If Err.Number <> 0 Then MsgBox "失敗1"
        fobj.InvokeVerbEx exec
        If Err.Number <> 0 Then MsgBox "失敗2"
        On Error GoTo 0
    End With
 End Sub

 execをVariantにしても結果は、test2とかわりません。

 Sub test4()
    Dim fobj As Object
    Dim flpath As Variant
    flpath = "D:\F\excel2010"
    Dim fnm As String
    fnm = "book1.pdf"
    Dim exec As String
    exec = "Print"
    With CreateObject("Shell.Application").Namespace(flpath)
        On Error Resume Next
        Set fobj = .ParseName(fnm)
        If Err.Number <> 0 Then MsgBox "失敗1"
        fobj.InvokeVerbEx (exec)
        If Err.Number <> 0 Then MsgBox "失敗2"
        On Error GoTo 0
    End With
 End Sub
 fobj.InvokeVerbEx (exec) と値渡し指定でやっと印刷されます。

（　ichinose） 2015/03/15(日) 17:42

ありがとうございます。
使い方に誤解がありました。今度はわかりました。（たぶん）

 しかも、exec="open"でテストしていては、
 デフォルトの動作が行われたのか区別がつかないわけですね。

（マナ） 2015/03/15(日) 19:35

 名前が出てたので紹介。

[[20140108105535]]

 自分でも忘れてた！
 確かに苦労した覚えがあります！
 マナさんありがとう！
（稲葉） 2015/03/16(月) 10:08

追加で質問したいのですが、一番上のコードを実行する際に、ファイルシステムオブジェクトの参照を作ったので、Set fso=nothingは書くべきだと思うのですが、なぜ書かないのでしょうか？

あと、今日会社でコードを実行したところ、実行中が永遠と続いて、印刷できませんでした。以前会社で実行したときはマクロの実行が一瞬で終わり、印刷できなかったので、違う症状ですが、実行中が長く続いて印刷できないのはウイルス対策ソフトが原因でしょうか？
（スズメ） 2015/03/16(月) 12:09

 有用な回答が出来なくてすみませんが、2点コメントだけ。

 >Set fso=nothingは書くべきだと思うのですが、なぜ書かないのでしょうか？ 
 これは書くべきと考える人も多いと思いますが、いろいろな説もあり私自身は不要論者です。
 （ケースによって必要な場合もあることは認識していますが。）

 検索すれば他にもいろいろあると思いますが、学校でも議論があったところです。
[[20101124111503]]　『Set と Nothing の使い方』（なた）

 >実行中が長く続いて印刷できないのは
 ずっと終わらないというのは、ステップ実行するとどこで返ってこなくなるのでしょうか。
 あるいは、ループ処理が延々と続いているのでしょうか？

（Mook） 2015/03/16(月) 12:55

         2015/03/16(月) 19:10 誤字訂正

おそらくどこかでつっかえているんだと思います。フォルダ内は１つのファイルしかないのでループが永遠に続くことはないと思います。
（スズメ） 2015/03/16(月) 16:18

 >Set fso=nothingは書くべきだと思うのですが、なぜ書かないのでしょうか？

 私は、付けるべきだという意見を2010年11月時点と同じで変えてはいません。
 理由は、メンテしやすい　という事を　当時も記述していますが、同じです。

 これまたやりたいですねえ！！

 こういう議論を冷静にできるということ意味があると思いますよ！！

 >今日会社でコードを実行したところ、実行中が永遠と続いて、印刷できませんでした

 この問題は、まず　Shellを使って、特別な環境（スズメさんの環境）だと印刷が出来るのか否か
 という問題と

 Shell　又は　FSOで正しく　ファイル名を認識しているのか？　という二つ問題を分けて
 見てはいかがですか？

 私が提示した

 '====================================================================================
 Sub test1()
    Dim fpath As Variant
    fpath = Application.GetOpenFilename("すべてのファイル,*.*")
    If TypeName(fpath) <> "Boolean" Then
       If file_invorke(fpath, "印刷(&P)") <> 0 Then MsgBox "失敗"
    End If
 End Sub
 Function file_invorke(ByVal flpath As String, Optional exec As Variant = "開く(&O)") As Long
    Dim path As String
    Dim fnm As String
    Dim fobj As Object
    Dim v As Object
    On Error Resume Next
    With CreateObject("scripting.filesystemobject")
       path = .GetParentFolderName(flpath)
       fnm = .GetFileName(flpath)
    End With
    With CreateObject("Shell.Application").Namespace((path))
       Set fobj = .ParseName((fnm))
       For Each v In fobj.Verbs
          If v.Name = exec Then
             v.doit
             Exit For
          End If
       Next
      file_invorke = Err.Number
    End With
    On Error GoTo 0
 End Function
 Sub test2()
    Dim fpath As Variant
    fpath = Application.GetOpenFilename("すべてのファイル,*.*")
    If TypeName(fpath) <> "Boolean" Then
       If file_invorke2(fpath, "Print") <> 0 Then MsgBox "失敗"
    End If
 End Sub
 Function file_invorke2(ByVal flpath As String, Optional exec As Variant = "Open") As Long
    Dim path As String
    Dim fnm As String
    Dim fobj As Object
    Dim v As Object
    On Error Resume Next
    With CreateObject("scripting.filesystemobject")
       path = .GetParentFolderName(flpath)
       fnm = .GetFileName(flpath)
    End With
    With CreateObject("Shell.Application").Namespace((path))
       Set fobj = .ParseName((fnm))
       fobj.InvokeVerbEx (exec)
       file_invorke2 = Err.Number
    End With
    On Error GoTo 0
 End Function

 test1とtest2は、どちらも　ファイル選択ダイアログが表示されますから、印刷したいファイルを選択してください。選択後、ＯＫボタンクリックしてください。私の環境では、どちらも印刷が可能です。

 これで適当な　PFDファイルを選択して印刷できるのか否かを　確認してください。

 Excelブックの指定では、うまくいきませんでした（ループしっぱなしになりました）。

 PDFファイルが印刷が可能なら、ファイル名の取得の問題だと思いますし、
 印刷ができないなら、そもそもShellを使っての印刷に問題がある事になります。

（　ichinose） 2015/03/16(月) 19:02

なるほど。今日私は会社でエクセルを印刷することを試みました。なぜエクセルは印刷できないのでしょうか？
（スズメ） 2015/03/16(月) 20:08

 >なぜエクセルは印刷できないのでしょうか
 ちょっと手直ししてVBSで実行すれば、Excelブックも印刷できますから、
 ExcelVBAでブックを印刷しようとしていることが問題なのでしょうね！！

 おそらく　v.doit　このメソッドで　戻ってこないのだと思います。

 VBAで実行する限り　Excelブックなら、他に方法がありますから、区別すればよいと思いますよ

（　ichinose） 2015/03/16(月) 20:58

どうも回答ありがとうございました。明日再度、会社でpdfの印刷を試みたいと思います。
（スズメ） 2015/03/16(月) 21:28

pdfファイルがちょうどなかったので代わりにワード(docx)の印刷を試みたところ、うまくいきました。みなさま、どうもありがとうございました。
（スズメ） 2015/03/17(火) 12:08

コメント返信：

[ 一覧(最新更新順) ]

[[20150314100926]] 『vbaでpdfやxdwの印刷について』（スズメ） ページの最後に飛ぶ

[[20150314100926]]　『vbaでpdfやxdwの印刷について』（スズメ）　ページの最後に飛ぶ