VBAでフォルダ内のファイル名を一括取得

当ページのリンクには広告が含まれています。

指定したフォルダ内 にある ファイルすべての「名前」と「拡張子」を取得し、セルに貼付けるテクニックの紹介です。

「ファイル整理」や「文書管理」を行う際に使えます。

VBAを使用することで効率良く実施することが可能です。

動画を見ればイメージができるかと思います

クリックしてジャンプ

イメージ動画（音声はありません）

VBAコード

FileSystemObjectを使用して、ファイルシステムにアクセスします。
FileDialogオブジェクトを使用してフォルダ選択ダイアログを表示し、ユーザーの選択を取得します。
選択されたフォルダ内の各ファイルに対して、ファイル名を.で分割し、名前と拡張子を分けます。
分割したファイル名をB列に、拡張子をC列にそれぞれ記入します。
AutoFitメソッドを使用して、B列とC列の幅を内容に合わせて自動調整します。

以下のコードを実行する際の注意点

FileSystemObject を使うためには「参照設定」の追加が必要です

Sub ListFilesAndExtensionsToWorksheet()
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    If fd.Show = -1 Then ' ユーザーがフォルダを選択した場合
        Dim folderPath As String
        folderPath = fd.SelectedItems(1) ' 選択されたフォルダのパスを取得
        
        Dim folder As folder
        Set folder = fso.GetFolder(folderPath)
        
        Dim file As file
        Dim i As Integer
        i = 3 ' B3セルから開始
        
        Dim ws As Worksheet
        Set ws = ActiveSheet ' 現在アクティブなワークシートを使用
        
        ' B3セルから下とC3セルから下をクリアする
        ws.Range("B3:B" & ws.Rows.count).ClearContents
        ws.Range("C3:C" & ws.Rows.count).ClearContents
        ws.Range("D3:D" & ws.Rows.count).ClearContents
        
        Dim fileName As String
        Dim fileParts() As String
        For Each file In folder.Files
            fileName = file.Name
            fileParts = Split(fileName, ".") ' ファイル名を「.」で分割
            
            ' 名前と拡張子を別々の列に設定
            If UBound(fileParts) > 0 Then
                ws.Cells(i, 2).Value = Join(ArrayLeft(fileParts, UBound(fileParts)), ".") ' B列に名前
                ws.Cells(i, 3).Value = "." & fileParts(UBound(fileParts)) ' C列に拡張子
            Else
                ws.Cells(i, 2).Value = fileName ' 拡張子がない場合は名前のみ
            End If
            
            i = i + 1
        Next file
        
        ' B列とC列の幅を自動調整
        ws.Columns("B:B").AutoFit
        ws.Columns("C:C").AutoFit
    Else
        MsgBox "フォルダが選択されませんでした。"
    End If
End Sub

' 配列の左側の要素を指定された数だけ取得する関数
Function ArrayLeft(arr() As String, count As Integer) As String()
    Dim result() As String
    ReDim result(count - 1)
    
    Dim i As Integer
    For i = 0 To count - 1
        result(i) = arr(i)
    Next i
    
    ArrayLeft = result
End Function