Sub PrintLatestExcelAndPDFInSubfolders()
Dim ws As Worksheet
Dim folderRange As Range
Dim folderCell As Range
Dim parentFolderPath As String
Dim folderName As String
Dim folderPath As String
Dim latestExcel As String
Dim latestExcelDate As Date
Dim latestPDF As String
Dim fileName As String
Dim alertsSetting As Boolean
' アラートを一時的に無効にする
alertsSetting = Application.DisplayAlerts
Application.DisplayAlerts = False
' シート名を設定
Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を変更
' 親フォルダのパスを指定
parentFolderPath = "C:\YourParentFolderPath\" ' 親フォルダのパスを指定
' フォルダ名がリストアップされた範囲を指定
Set folderRange = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
' 各セル(フォルダ名)に対して処理
For Each folderCell In folderRange
folderName = folderCell.Value ' フォルダ名を取得
folderPath = parentFolderPath & folderName & "\" ' 最下層フォルダのパスを作成
' フォルダ内のExcelファイルを一つずつ処理
fileName = Dir(folderPath & "*.xlsx") ' .xlsx ファイルを対象にする場合
Do While fileName <> ""
' Excelファイルの更新日を取得
If FileDateTime(folderPath & fileName) > latestExcelDate Then
latestExcelDate = FileDateTime(folderPath & fileName)
latestExcel = fileName
End If
' 次のファイルを取得
fileName = Dir
Loop
' フォルダ内のPDFファイルを一つずつ処理
fileName = Dir(folderPath & "*.pdf")
Do While fileName <> ""
' PDFファイルの更新日を取得
latestPDF = fileName
' 次のファイルを取得
fileName = Dir
Loop
' 最新のExcelファイルを印刷
If latestExcel <> "" Then
' ファイルを開く
Set wb = Workbooks.Open(folderPath & latestExcel, UpdateLinks:=False)
' シートを印刷
wb.Sheets(1).PrintOut
' ファイルを閉じる
wb.Close SaveChanges:=False
End If
' PDFファイルがある場合はPDFを印刷
If latestPDF <> "" Then
ShellExecute 0, "print", folderPath & latestPDF, vbNullString, vbNullString, 0
End If
' 初期化
latestExcel = ""
latestExcelDate = 0
latestPDF = ""
Next folderCell
' アラートの設定を元に戻す
Application.DisplayAlerts = alertsSetting
End Sub