本部長は管理ができない

Salesforceに関わっているエンジニアの技術メモ。ときどきそれ以外。

ファイルリスト作成マクロ

ファイルリストを作成するExcelマクロ。
拡張子は「xls;xlsx」のように指定。セパレータは何でも良い。
さぼったので、見つけたファイルの拡張子が上記文字列に含んでいるかのチェックしかしていない。
なので、「xlsx」と指定しても「xls」も拾えてしまう。
セパレータを定数にして、splitでリストに入れて、リストをチェックすれば回避可能かと。

' ------------------------------------------------------------------
' ファイルリストの生成
'  A列にファイルのフルパス、B列にファイル名を出力
' targetFolder      :検索対象のフォルダパス
' targetExtensions  :検索対象の拡張子(何かで区切ってあること)
' outputSheet       :ファイルリストの出力先シート
' outputStartRow    :ファイルリストの出力先開始行番号
' ------------------------------------------------------------------
Private Sub createFileList(targetFolder As String, targetExtensions As String, outputSheet As Worksheet, outputStartRow As Integer)
    Dim fileList As Object
    Dim fileObj As Variant
    Dim folderList As Object
    Dim folderObj As Variant
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim fileExtension As String
    
    ' ファイルを取得
    Set fileList = CreateObject("Scripting.FileSystemObject").GetFolder(targetFolder).Files
    For Each fileObj In fileList
        ' 拡張子をチェック
        fileExtension = fso.GetExtensionName(fileObj.Path)
        If targetExtensions = "" Or InStr(targetExtensions, fileExtension) <> 0 Then
            outputStartRow = outputStartRow + 1
            outputSheet.Cells(outputStartRow, 1) = fileObj.Path
            outputSheet.Cells(outputStartRow, 2) = fso.GetBaseName(fileObj.Path)
        End If
    Next
    
    ' サブフォルダを取得し、そのサブフォルダ内のリストを生成
    Set folderList = CreateObject("Scripting.FileSystemObject").GetFolder(targetFolder).SubFolders
    For Each folderObj In folderList
        Call createFileList(folderObj.Path, targetExtensions, outputSheet, outputStartRow)
    Next
End Sub