No.1528　条件に一致するファイル一覧を出力　その１

毎度おなじみ、わかってる人にもわからない人にも役に立たないシリーズw
あるフォルダの下にあるJPGファイルの一覧を作りたい、と。職場でうだうだした流れをメモっておく。

はじめに

まずコチラのコードをお借りしてベース作ったぞ
blog.jmiri.net

ちょーっとだけ手を入れたコードを晒す

コメントまでそのままでさーせん(；´Д｀)

Option Explicit

Sub setFileList(searchPath)
    Dim startCell As Range
    Dim maxRow As Long
    Dim maxCol As Long

    Set startCell = Cells(5, 2) 'このセルから出力し始める
    startCell.Select
    
    'シートをいったんクリア
    maxRow = startCell.SpecialCells(xlLastCell).Row
    maxCol = startCell.SpecialCells(xlLastCell).Column
    If startCell.Row < maxRow Then
        Range(startCell, Cells(maxRow, maxCol)).ClearContents
    End If
    
    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

    'サブフォルダ取得
    For Each objFolders In FSO.GetFolder(searchPath).SubFolders
        Call getFileList(objFolders.Path)
    Next
    
    'ファイル名の取得
    For Each objFiles In FSO.GetFolder(searchPath).Files
        Dim myfile As String
        Dim mypath As String
        
        separateNum = InStrRev(objFiles.Path, "\")
        'セルにパスとファイル名を書き込む
        
        mypath = Left(objFiles.Path, separateNum - 1)
        myfile = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
        If myfile Like "*.jpg" Or myfile Like "*.JPG" Then
            ActiveCell.Value = mypath
            ActiveCell.Offset(0, 1).Value = myfile
            ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
            ActiveCell.Offset(0, 3).Value = Format((FileLen(objFiles) / 1024), "#.0")
            ActiveCell.Offset(1, 0).Select
        End If
    Next
    
End Sub
Sub pushButton()
    Dim t1, t2
    t1 = Timer
    Call setFileList(Cells(2, 2))   'フォルダパスを入力するセル
    t2 = Timer
    MsgBox (Format(t2 - t1, "0.0秒かかったよ"))
End Sub

実行結果

f:id:elve:20180301182427p:plain

早くしたい

さて、我々世代でファイル一覧といえばdirコマンドが使いたくなるでしょ？　しょ？
先に言っておくと、これはすげー早くなったがunicodeのファイル名があって死んだ。
誰だよ「❀」とかファイル名につけてる奴・・・。

excel-ubara.com
を参考に別関数を作って試してみる。参考にっつーか丸写し。

Sub getFileListDir(searchPath)
    Dim i As Long
    Dim aryDir() As String
    Dim aryFile() As String
    Dim strName As String
  
    i = 0
    ReDim aryDir(i)
    aryDir(i) = searchPath 'フォルダをここで指定
    'まずは、指定フォルダ以下の全サブフォルダを取得し、配列aryDirに入れます。
    Do
        strName = Dir(aryDir(i) & "\", vbDirectory)
        Do While strName <> ""
            If GetAttr(aryDir(i) & "\" & strName) And vbDirectory Then
                If strName <> "." And strName <> ".." Then
                    ReDim Preserve aryDir(UBound(aryDir) + 1)
                    aryDir(UBound(aryDir)) = aryDir(i) & "\" & strName
                End If
            End If
            strName = Dir()
        Loop
        i = i + 1
        If i > UBound(aryDir) Then
            Exit Do
        End If
    Loop
  
    '配列aryDirの全フォルダについて、ファイルを取得し、配列aryFileに入れます。
    ReDim aryFile(0)
    For i = 0 To UBound(aryDir)
        strName = Dir(aryDir(i) & "\*.jpg")
        Do While strName <> ""
            If aryFile(0) <> "" Then
                ReDim Preserve aryFile(UBound(aryFile) + 1)
            End If
            aryFile(UBound(aryFile)) = aryDir(i) & "\" & strName
            '実行結果が分かりやすいように、テスト的にセルに書き出す場合
            Cells(UBound(aryFile) + 5, 2) = aryFile(UBound(aryFile))
            strName = Dir()
        Loop
    Next
End Sub