ファイル一覧生成マクロ

Option Explicit

Sub ファイル一覧生成()

'参考サイト：http://blog.jmiri.net/?p=1763

Call setFileList(ThisWorkbook.Path)

End Sub

Sub setFileList(searchPath)

Dim startCell As Range
Dim maxRow As Long
Dim maxCol As Long

'データ設定開始位置
Set startCell = Cells(2, 1)
startCell.Select

'データ設定範囲の初期化
maxRow = startCell.SpecialCells(xlLastCell).Row
maxCol = startCell.SpecialCells(xlLastCell).Column
Range(startCell, Cells(maxRow, maxCol)).ClearContents

'カレントフォルダ配下のファイル一覧取得
Call getFileList(searchPath)

startCell.Select

End Sub

Sub getFileList(searchPath)

Dim FSO As New FileSystemObject
Dim objFiles As File
Dim objFolders As Folder
Dim separateNum As Long

Dim cur_BookName, fpath, fname

'現在のブック名を取得
cur_BookName = ActiveWorkbook.Name

'サブフォルダ取得
For Each objFolders In FSO.GetFolder(searchPath).SubFolders
    Call getFileList(objFolders.Path)
Next

'ファイル名の取得
For Each objFiles In FSO.GetFolder(searchPath).Files

    separateNum = InStrRev(objFiles.Path, "\")
    
    'パスとファイル名を取得
    fpath = Left(objFiles.Path, separateNum - 1)
    fname = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
    
    '現在のブックを除く
    If cur_BookName <> fname And "~$" & cur_BookName <> fname Then
    
        'パス
        ActiveCell.Value = fpath
        'パスにリンクを挿入
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fpath, TextToDisplay:=fpath
        
        'ファイル名
        ActiveCell.Offset(0, 1).Value = objFiles.Name
        
        '種類
        ActiveCell.Offset(0, 2).Value = objFiles.Type
        '生成日時
        ActiveCell.Offset(0, 3).Value = objFiles.DateCreated
        '更新日時
        ActiveCell.Offset(0, 4).Value = objFiles.DateLastModified
        'サイズ（KB)
        ActiveCell.Offset(0, 5).Value = Format((FileLen(objFiles) / 1024), "#.0")

        'ファイル名にリンクを挿入
        ActiveCell.Offset(0, 1).Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=fpath & "\" & fname, TextToDisplay:=fname

        ActiveCell.Offset(1, -1).Select
    
    End If
    
Next

End Sub