[[20180606152054]]　『サブフォルダも印刷』（ゾーマ）　ページの最後に飛ぶ

『サブフォルダも印刷』（ゾーマ）

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function ShellExecute Lib "SHELL32" Alias "ShellExecuteA" _

    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
     ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub ファイル印刷1()

    Dim strPath As String
    Dim strName As String

    Rtn = MsgBox("テキストファイルを印刷します。" & vbCrLf & "実行しますか？", vbYesNo)
    If Rtn = vbNo Then Exit Sub

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択して、ＯＫをクリック"
            If .Show = True Then
            folder = .SelectedItems(1)
            Else
            Exit Sub
        End If
    End With

    strPath = folder & "\"
    strName = Dir(strPath & "*.txt")

    Do Until strName = ""
        Call ShellExecute(Application.hwnd, "print", strPath & strName, vbNullString, "", 0)
        strName = Dir()
        Sleep 1000
    Loop

    MsgBox ("終了しました。")
End Sub

上記コードでフォルダのtxtファイルを印刷してたのですが、サブフォルダも印刷可能にするにはどこをどのように変更したら良いのでしょうか。
ちなみに容量順に印刷されてしまうのでＳｌｅｅｐで1秒実行を待つようにしてます。

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

APIを使ったコーディングをするレベルの方は、自分で全て調べ、試して解決すべき！、とは思っていますが、確かにどんな階層になっているか判らないサブフォルダの検索は難しいですね。再帰処理できる関数にするとか、配列化して1階層ずつ調べていくとか、面倒なロジックにしないといけません。

なので、コマンドプロンプトのDIRコマンドを使った例を書きます。 DIRコマンドは、オプションでサブフォルダまで全部探す事ができるのですよ。

 Sub test()
    Dim cFiles As Variant
    Dim strPath As String
    Dim i As Long

    If MsgBox("テキストファイルを印刷します。" & vbLf & "実行しますか？", vbYesNo Or vbQuestion) <> vbYes Then
        Exit Sub
    End If

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択して、ＯＫをクリック"
        If .Show <> True Then
            Exit Sub
        End If
        strPath = .SelectedItems(1) & "\"
    End With

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & strPath & "*.txt""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        Call ShellExecute(Application.hwnd, "print", cFiles(i), vbNullString, "", 0)
        Sleep 1000
    Next i

    MsgBox "終了しました。", vbInformation
 End Sub
（???） 2018/06/06(水) 16:51

？？？様
返信遅れました。
APIを使いこなせてるわけではなく、ネットで拾ってきたやつの組み合わせなので
私自身の知識は０なんですよね＾＾；；；

さて、上記コードですが、無事サブフォルダも印刷することができました
ありがとうございました。
（ゾーマ） 2018/06/10(日) 14:00

コメント返信：

[ 一覧(最新更新順) ]

[[20180606152054]] 『サブフォルダも印刷』（ゾーマ） ページの最後に飛ぶ

[[20180606152054]]　『サブフォルダも印刷』（ゾーマ）　ページの最後に飛ぶ