フォルダ内ファイル名取得エクセル　ダウンロード可

ファイルを整理したいときにフォルダ内のファイル一覧があるとすごく便利です。
簡単操作で使用できる、フォルダとファイル名、サイズ、更新日の一覧をエクセルに表示しフォルダにリンクも張った便利な機能付きエクセルです。

最後尾でダウンロードも出来ます。

エクセル画面

使用はいたって簡単。

使用手順

フォルダ選択

エクセル上のテキストボックスの赤枠の部分をＷクリックする。

ファイルダイアログが開くのでフォルダを選択してOKボタンをクリックする。

たったこれだけでフォルダ、ファイル名の一覧がエクセル上に表示されます。

エラーメッセージ

フォルダ内にファイルがない場合は次のメッセージが表示されます。

Cドライブ（OSインストールドライブ)に多いのですがアクセス許可のないフォルダ、読めない文字（中国の漢字等）が有ると次のメッセージが出ますので解決してから使用して下さい。

エクスプローラで一度開くとアクセス許可は解消される場合もあります。

終了

赤枠のストップボタンをクリックでエクセルを閉じ終了します。

表示内容

フォルダ名（リンク付き）
ファイル名
ファイルサイズ
ファイルの更新日時

フォルダにリンクを張っていますので気になるファイルをすぐに見つける事が出来便利です。

ファイル数10,000でやく1分30秒くらいで書き出せます。

VBAコード

VBAコードに関しては独学でコピー&ペーストが多いので詳細な説明はしていません。

Private Sub Workbook_Open()If
‘—エクセル開く時リボンを折りたたむApplication.CommandBars.GetPressedMso(“MinimizeRibbon”) = False Then _
Application.CommandBars.ExecuteMso “MinimizeRibbon”

‘—エクセル画面クリア
Worksheets(“ファイル名一覧”).Columns(“A:D”).ClearContents
Worksheets(“ファイル名一覧”).Range(“A:A”).ColumnWidth = 55
End Sub
———————————————————————————–

Private Sub フォルダ選択_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo AAA
‘—前の表示画面クリア
フォルダ選択 = “”
Worksheets(“ファイル名一覧”).Columns(“A:D”).ClearContents

’—罫線クリア
Worksheets(“ファイル名一覧”).Columns(“A:D”).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Range(“A1”).Select

‘—選択したフォルダ名を格納する変数
Dim SFL As String
With Application.FileDialog(msoFileDialogFolderPicker)
‘—ダイアログボックスを表示
If .Show = True Then
‘—OKボタンが押された場合、フォルダ名を取得する
SFL = .SelectedItems(1)
‘—メッセージを表示
End If
End With

If SFL = “” Then MsgBox (“フォルダを選択して下さい。”): Exit Sub
‘—フォルダ、ファイル名取得
Dim i As Long
Dim ADR() As String
Dim AFL() As String
Dim ANM As String
Dim fso As New FileSystemObject
Dim filePath As String
Dim fileSize As Long

ReDim ADR(i)
ADR(i) = SFL
‘—引数のフォルダを配列の先頭に入れる

‘—指定フォルダ以下の全サブフォルダを取得して配列ADRに入れる。
i = 0
Do
ANM = Dir(ADR(i) & “\”, vbDirectory)
Do While ANM <> “”
If GetAttr(ADR(i) & “\” & ANM) And vbDirectory Then
If ANM <> “.” And ANM <> “..” Then
ReDim Preserve ADR(UBound(ADR) + 1)
ADR(UBound(ADR)) = ADR(i) & “\” & ANM
End If
End If
ANM = Dir()
Loop
i = i + 1
If i > UBound(ADR) Then Exit Do
Loop

‘—配列ADRの全フォルダのファイルを取得して配列AFLに入れる。
ReDim AFL(0)
For i = 0 To UBound(ADR)
ANM = Dir(ADR(i) & “\”, vbNormal + vbHidden + vbReadOnly + vbSystem)
B = ANM
Do While ANM <> “”
If AFL(0) <> “” Then
ReDim Preserve AFL(UBound(AFL) + 1)
End If
AFL(UBound(AFL)) = ADR(i) & “\” & ANM
ANM = Dir()
Loop
Next

‘—エクセルに書き出し
‘—エクセルシートのAD列をクリアーにする。
Worksheets(“ファイル名一覧”).Columns(“A:D”).ClearContents

‘—項目
Worksheets(“ファイル名一覧”).Cells(2, 1) = “フォルダ名”
Worksheets(“ファイル名一覧”).Cells(2, 2) = “ファイル名”
Worksheets(“ファイル名一覧”).Cells(2, 3) = “サイズKB”
Worksheets(“ファイル名一覧”).Cells(2, 4) = “更新日時”

‘—項目書式
Worksheets(“ファイル名一覧”).Columns(“C:C”).NumberFormatLocal = “#,##0_ ”
Worksheets(“ファイル名一覧”).Columns(“D:D”).NumberFormatLocal = “yyyy/mm/dd”
Worksheets(“ファイル名一覧”).Columns(“D:D”).HorizontalAlignment = xlCenter
Worksheets(“ファイル名一覧”).Range(“A2:D2”).Font.Size = 14
Worksheets(“ファイル名一覧”).Range(“A2:D2”).Font.Bold = True

For i = O To UBound(AFL)

‘—フォルダ名とファイル名を分割して列AとBに書き出し。
ITI = InStrRev(AFL(i), “\”)
Worksheets(“ファイル名一覧”).Cells(i + 3, 1) = Left$(AFL(i), ITI) ‘フォルダ名Worksheets(“ファイル名一覧”).Cells(i + 3, 2) = Right$(AFL(i), Len(AFL(i)) – ITI)

‘—ファイル名
filePath = AFL(i)
fileSize = Int(fso.GetFile(filePath).Size / 1024 + 0.5)
Worksheets(“ファイル名一覧”).Cells(i + 3, 3) = fileSize ‘ファイルサイズ
kousindate = fso.GetFile(filePath).DateLastModified ‘ 更新日時を取得
Worksheets(“ファイル名一覧”).Cells(i + 3, 4) = Format(kousindate, “yyyy/mm/dd”) ‘ファイル更新日
Next i

‘—フォルダ名昇順で並べ替得る前に一旦クリアする
Worksheets(“ファイル名一覧”).Sort.SortFields.Clear

‘—フォルダ名昇順で並べ替え
ActiveWorkbook.Worksheets(“ファイル名一覧”).Sort.SortFields.Add Key:=Range(“A:A”) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(“ファイル名一覧”).Sort
.SetRange Range(Cells(3, 1), Cells(UBound(AFL) + 3, 4))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

‘—総ファイル数表示
Worksheets(“ファイル名一覧”).Cells(1, 2) = “　　総ファイル数=” & UBound(AFL) + 1
Worksheets(“ファイル名一覧”).Cells(1, 2).Font.Size = 14
Worksheets(“ファイル名一覧”).Cells(1, 2).Font.Bold = True
‘列幅に合わせる
Worksheets(“ファイル名一覧”).Columns(“A:D”).EntireColumn.AutoFit
‘A列幅を最小でも55とする。
If Worksheets(“ファイル名一覧”).Range(“A:A”).ColumnWidth < 55 Then Worksheets(“ファイル名一覧”).Range(“A:A”).ColumnWidth = 55

‘—リンク作成
For i = 3 To UBound(AFL) +3
If Worksheets(“ファイル名一覧”).Cells(i, 1) = “” Then GoTo 300
For j = i + 1 To UBound(AFL) + 4
If Worksheets(“ファイル名一覧”).Cells(i, 1) = Worksheets(“ファイル名一覧”).Cells(j, 1) Then Worksheets(“ファイル名一覧”).Cells(j, 1) = “”
Next j

200
Worksheets(“ファイル名一覧”).Cells(i, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Worksheets(“ファイル名一覧”).Cells(i, 1).Value, TextToDisplay:=Worksheets(“ファイル名一覧”).Cells(i, 1).Value

300
Next i

‘—罫線
For i = 3 To UBound(AFL) + 3
If Worksheets(“ファイル名一覧”).Cells(i, 1) <> “” Then GoTo 400 Else GoTo 500
400
Worksheets(“ファイル名一覧”).Range(Worksheets(“ファイル名一覧”).Cells(i, 1), Worksheets(“ファイル名一覧”).Cells(i, 4)).Borders(xlEdgeTop).LineStyle = 1
500
Next i
Worksheets(“ファイル名一覧”).Range(Worksheets(“ファイル名一覧”).Cells(UBound(AFL) + 4, 1), Worksheets(“ファイル名一覧”).Cells(UBound(AFL) + 4, 4)).Borders(xlEdgeTop).LineStyle = 1

GoTo OWARI

‘—エラー処理
AAA:
If Err = 5 Then MsgBox (“ファイルが有りません”): Exit Sub
If Err = 52 Then MsgBox (“アクセス許可のないフォルダが有ります”): Exit Sub

OWARI:
Range(“A1”).Select
End Sub