Sub prcOutputPDFNamesAndSort()
' 機能概要: 指定フォルダ内(サブフォルダ含む)のPDFファイル名を取得し、
' シートAのセルA1から行方向に出力し、ファイル名順に並び替える
' 引数: なし
' 備考: FileSystemObjectを使用
Dim fso As FileSystemObject
Dim folder As Folder
Dim file As file
Dim strFolderPath As String
Dim ws As Worksheet
Dim row As Integer
Dim pdfFiles As Collection
Set fso = New FileSystemObject
Set pdfFiles = New Collection
strFolderPath = "C:\FolderA" ' ここにフォルダのパスを指定
Set folder = fso.GetFolder(strFolderPath)
Set ws = ThisWorkbook.Sheets("SheetA") ' シート名を指定
row = 1
' PDFファイル名をコレクションに追加
Call AddPDFFiles(folder, pdfFiles)
' PDFファイル名をシートに出力
For Each file In pdfFiles
ws.Cells(row, 1).Value = file.Name
row = row + 1
Next file
' ファイル名順に並び替え
With ws.Sort
.SetRange ws.Range("A1:A" & pdfFiles.Count)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' オブジェクトの解放
Set fso = Nothing
End Sub
' PDFファイル名をコレクションに追加する再帰関数
Sub AddPDFFiles(folder As Folder, pdfFiles As Collection)
Dim subFolder As Folder
Dim file As file
' フォルダ内のPDFファイルを追加
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Name)) = "pdf" Then
pdfFiles.Add file
End If
Next file
' サブフォルダを処理
For Each subFolder In folder.SubFolders
AddPDFFiles subFolder, pdfFiles
Next subFolder
End Sub
コメント