業務ちょっとだけ自動化計画

IT系の仕事で使えそうな小技やツールを紹介します。

フォルダ内のファイル一覧を取得する

フォルダ内のファイルの一覧を取得するExcelマクロです。

画面イメージ

f:id:emk7ny:20170329165753p:plain

マクロの内容
Const ROWIDX_TARGET_FOLDER = 2
Const ROWIDX_FILELIST_START = 9

Const COLIDX_NUMBER = 2
Const COLIDX_FILENAME = 3
Const COLIDX_FILEDATE = 4
Const COLIDX_FILELEN = 5


'--------------------------------------------------------------------------
' 指定フォルダ内のすべてのファイルを出力
'--------------------------------------------------------------------------
Public Sub ファイル一覧取得()
    
    '■対象フォルダ指定
    Dim folderName As String
    folderName = Cells(ROWIDX_TARGET_FOLDER, 2)
    
    '■初期化処理
    ClearFileList
    
    '■ファイル一覧出力処理
    Dim fsObj As Object
    Dim rowNo As Long
    Set fsObj = CreateObject("Scripting.FileSystemObject")
    rowNo = ROWIDX_FILELIST_START
    Call OutputFilesInfo(fsObj, folderName, rowNo)
    Set fsObj = Nothing
    
    MsgBox "完了", vbInformation
    
End Sub


 '--------------------------------------------------------------------------
 ' 指定フォルダ内のファイル情報を出力(サブフォルダ内も)
 '--------------------------------------------------------------------------
 Private Sub OutputFilesInfo(ByVal fsObj As Object, ByVal folderName As String, ByRef rowNo As Long)
    
    Dim fileObj As Object
    Dim folderObj As Object
    
    'フォルダ内のファイルを繰り返し処理
    For Each fileObj In fsObj.GetFolder(folderName).Files
        Cells(rowNo, COLIDX_NUMBER) = rowNo - ROWIDX_FILELIST_START + 1
        Cells(rowNo, COLIDX_FILENAME) = fileObj.Path
        Cells(rowNo, COLIDX_FILEDATE) = fileObj.DateLastModified
        Cells(rowNo, COLIDX_FILELEN) = fileObj.Size
        rowNo = rowNo + 1
    Next

    'フォルダ内のサブフォルダを繰り返し処理
    For Each folderObj In fsObj.GetFolder(folderName).SubFolders
        Call OutputFilesInfo(fsObj, folderObj.Path, rowNo)
    Next

End Sub


'--------------------------------------------------------------------------
' ファイル一覧のクリア
'--------------------------------------------------------------------------
Private Sub ClearFileList()
    
    '使用済みRangeの取得
    Dim usedRange As Range
    Set usedRange = ActiveSheet.usedRange
    
    '最終行番号の取得
    Dim maxRow As Long
    maxRow = usedRange.Rows(usedRange.Rows.Count).Row
    
    '最終列番号の取得
    Dim maxCol As Long
    maxCol = usedRange.Columns(usedRange.Columns.Count).Column
    
    'ファイル一覧のデータを選択
    Range(Cells(ROWIDX_FILELIST_START, COLIDX_NUMBER), Cells(maxRow, maxCol)).Select
    
    'データをクリア
    Selection.ClearContents
    
    '左上のセルを選択
    Cells(ROWIDX_FILELIST_START, COLIDX_NUMBER).Select
    
End Sub