複数フォルダにある複数ファイルの一括印刷

質問

下記の通りフォルダの中にある、複数のエクセルファイルを印刷するマクロを使用しています
（どこからか、参考にして自分なりに変更したら、出来たのですが・・・）

一つのフォルダに存在する複数フォルダの複数ファイルを、上記同様に印刷する方法は
どのようにすればよいのでしょうか？（フォルダは30個位、ファイル１～20個位、増減あり）
どなたか、お知恵をお貸しください。お願いいたします。

Sub test()
'
'　印刷マクロ
'
Dim fol As String
Dim f As String
Dim wb As Workbook
Dim wscnt As Long
Dim i As Long
fol = "d:\sampul"
f = Dir(fol & "\*.xls")
Do While f <> ""
Set wb = Workbooks.Open(fol & "\" & f)
wscnt = wb.Worksheets.Count
For i = 1 To 1
wb.Worksheets(i).PrintOut
Next i
wb.Close
f = Dir()
Loop
Set wb = Nothing
End Sub

回答No.1

K Kazz（@JazzCorp） · ベストアンサー

'フォルダは、Const xPath0に設定する
'そのフォルダ直下のブックを対象にしないときは、Const xMode = False、にする
Option Explicit
Sub PrintRobo()
Const xPath0 = "d:\tmp\tmp\"
Const xMode = True
Dim xDirs() As Variant
Dim xDir As String
Dim mm As Long
Debug.Print vbNewLine & Now & " ：Here We 5！"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ChDir xPath0
If (xMode) Then
Debug.Print xPath0
Call PrintAllBooksAllSheets(xPath0 & "\")
End If
xDir = Dir(xPath0 & "*.*", vbDirectory)
Do Until (xDir = Empty)
If GetAttr(xDir) And vbDirectory Then
If (xDir <> ".") And (xDir <> "..") Then
mm = mm + 1
ReDim Preserve xDirs(mm)
xDirs(mm) = xDir
End If
End If
xDir = Dir()
Loop
For mm = 1 To UBound(xDirs)
Debug.Print xDirs(mm)
Call PrintAllBooksAllSheets(xPath0 & xDirs(mm) & "\")
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub PrintAllBooksAllSheets(ByVal fol As String)
Dim f As String
Dim i As Long
f = Dir(fol & "*.xls")
Do Until (f = Empty)
With Workbooks.Open(fol & f)
For i = 1 To .Sheets.Count
.Sheets(i).PrintOut
Next i
.Close (False)
f = Dir()
End With
Loop
End Sub

お礼

ありがとうございました。
おかげで問題がクリア出来ました。