VBA100本ノック 26本目：ファイル一覧作成

公開日：2020-11-16　最終更新日：2021-01-13

VBA100本ノック 26本目：ファイル一覧作成

指定フォルダ内のファイル一覧を作成する問題です。
Excelファイルにはハイパーリンクを設定します。

ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。

VBAテスト用のサンプルデータはご自身でご用意ください。

出題

#VBA100本ノック 26本目
フォルダ選択のダイアログでフォルダを指定し、フォルダ内にあるファイルの一覧を「ファイル一覧」シートのA列に出力してください。
・ファイル名,更新日時,サイズ※画像参照
・Excelファイル(xls,xlsx,xlsm)にはハイパーリンクを設定
※サブフォルダは不要です。

VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。

他の人の回答および解説を見て、書いたVBAを見直してみましょう。

頂いた回答

出題ツイートの引用ツイートでの回答

解説

フォルダ選択はApplication.FileDialogのmsoFileDialogFolderPickerを使います。
ファイルの一覧はDir関数またはFileSystemObjectで取得します。
ハイパーリンクはセルではなく、Worksheetに対して設定します。
まずは、Dir関数のサンプルから。


  
    
      Sub VBA100_26_01()

　　Dim ws As Worksheet

　　Set ws = ThisWorkbook.Worksheets("ファイル一覧")

　　

　　Dim sPath As String

　　With Application.FileDialog(msoFileDialogFolderPicker)

　　　　.InitialFileName = ws.Parent.Path & "\"

　　　　If Not .Show Then Exit Sub

　　　　sPath = .SelectedItems(1) & "\"

　　End With

　　

　　Application.ScreenUpdating = False

　　ws.Cells.Hyperlinks.Delete

　　ws.UsedRange.Offset(1).ClearContents

　　

　　Dim sFile As String, i As Long

　　i = 2

　　sFile = Dir(sPath)

　　Do Until sFile = ""

　　　　ws.Cells(i, 1).Value = sFile

　　　　ws.Cells(i, 2).Value = FileDateTime(sPath & sFile)

　　　　ws.Cells(i, 3).Value = FileLen(sPath & sFile)

　　　　If InStrRev(sFile, ".") > 0 Then

　　　　　　If Mid(sFile, InStrRev(sFile, ".")) Like ".xls*" Then

　　　　　　　　ws.Hyperlinks.Add Anchor:=ws.Cells(i, 1), Address:=sPath & sFile

　　　　　　End If

　　　　End If

　　　　i = i + 1

　　　　sFile = Dir()

　　Loop

　　

　　ws.UsedRange.EntireColumn.AutoFit

　　Application.ScreenUpdating = True

End Sub

ハイパーリンクを削除するくらいなら、シート全体をClearしてしまったほうが簡単な場合もあると思います。
シート全体をClearする場合とFileSystemObjectのVBAは記事補足に掲載しました。

補足

ハイパーリンクの設定されたセルに対して、
ClearContents
または、
=""
これらでは、ハイパーリンクの書式が残ってしまいます。
ClearFormatsと組み合わせて使う方法も考えられます。

ハイパーリンクを消すには、
Hyperlinks.Delete
または、
Clear
を使うと簡単です。

以下は、FileSystemObjectの参考VBAになります。


  
    
      Sub VBA100_26_02()

　　Dim ws As Worksheet

　　Set ws = Worksheets("ファイル一覧")

　　

　　Dim sPath As String

　　With Application.FileDialog(msoFileDialogFolderPicker)

　　　　.InitialFileName = ws.Parent.Path & "\"

　　　　If Not .Show Then Exit Sub

　　　　sPath = .SelectedItems(1)

　　End With

　　

　　Application.ScreenUpdating = False

　　With ws

　　　　.Cells.Clear

　　　　.Range("A1:C1") = Array("ファイル一覧", "更新日時", "サイズ")

　　　　.Columns(2).NumberFormatLocal = "yyyy/mm/dd hh:mm"

　　　　.Columns(3).NumberFormatLocal = "#,##0"

　　End With

　　

      　　Dim fso As New Scripting.FileSystemObject

　　Dim objFile As File, sExt As String

　　Dim i As Long

　　i = 2

　　For Each objFile In fso.GetFolder(sPath).Files

　　　　ws.Cells(i, 1).Resize(, 3) = Array(objFile.Name, _

　　　　　　　　　　　　　　　　　　　　　 objFile.DateLastModified, _

　　　　　　　　　　　　　　　　　　　　　 objFile.Size)

　　　　sExt = fso.GetExtensionName(objFile.Name)

　　　　If sExt Like "xls*" And _

　　　　　 Not objFile.Name Like "~$*" Then

　　　　　　ws.Hyperlinks.Add Anchor:=ws.Cells(i, 1), Address:=objFile.Path

　　　　End If

　　　　i = i + 1

　　Next

　　Set fso = Nothing

　　

　　ws.Range("A1").CurrentRegion.EntireColumn.AutoFit

　　Application.ScreenUpdating = True

End Sub

上記VBAでは、Excelファイルが開いている場合（"~$*"）はリンク設定しないようにしてみました。
一覧に出力しなくても良いかもしれませんが、"~$"ではじまるファイルが無い（と思うけど）とも限らないので一応出力だけはしておきました。

ハイパーリンクは、シートに設定できる数に上限があります。

Excel の仕様と制限
ワークシート内のハイパーリンク：65,530

今回のように1フォルダの場合は、さすがにこの制限にかかることは無いと思いますが、
サブフォルダまで含めて作成するような場合は、この制限にかかってしまう事もあり得ると思います。

Dir関数とFileSystemObjectについて

Dir関数には多くの制限があります。

Dir関数の制限について｜VBA技術解説

・3桁拡張子の指定時の問題・256バイトを超えるパス名が扱えない・UNICODEファイル名が扱えない・特殊なネットワークドライブでエラー・Dir関数の制限の最後に

この制限を回避する必要がある場合はFileSystemObjectを使ってください。
ただし、処理速度はDir関数に比べてFileSystemObjectはかなり遅くなります。
とはいえ、1,000ファイルくらいまでなら気になるような遅さではありません。

#を含むファイルパスについて

Microsoft サポート

Office プログラムで、ハイパーリンクのファイル名にシャープ文字を使用できない

@furyuteiさんによる解決

ハイパーリンクのアドレスにも「#」を含むファイルパスが設定できるようになりました！

サイト内関連ページ

第79回．ファイル操作Ⅰ（Dir）｜VBA入門

・Dir関数・Dir関数の使用例・Dir関数の実践例・Dir関数の制限について・Dir関数の関連記事

第95回．ハイパーリンク（Hyperlink）｜VBA入門

・Hyperlinksコレクション・Hyperlinkオブジェクト・ハイパーリンクの追加・ハイパーリンクの削除・既に設定されているハイパーリンクの扱い方

第119回．ファイルシステムオブジェクト（FileSystemObject）｜VBA入門

・FileSystemObjectオブジェクトの使用方法・FileSystemObjectオブジェクトのプロパティとメソッド・FileSystemObjectオブジェクトのメソッドの戻り値・FileSystemObjectオブジェクトの使用例・FileSystemObjectオブジェクトの関連記事と実践例

第21回．ファイル一覧を取得する（Do～LoopとDir関数）｜VBA再入門

・Dir関数・Dir関数の使い方・ファイルの一覧を取得するマクロVBAコード・Do～Loopステートメント・ExcelマクロVBA入門等の対応ページ

エクセルでファイル一覧を作成｜VBAサンプル集

VBAでサブフォルダ以下も含めて全てのファイル一覧を取得します。最初はサブフォルダは無視して、VBAにある関数とステートメントだけで作成します、その後に、FileSystemObjectで再帰処理をすることで、全てのサブフォルダも取得するようにしていきます。

DIR関数で全サブフォルダの全ファイルを取得｜VBAサンプル集

・Dir関数でサブフォルダも含むファイル一覧を取得するVBA ・ファイル一覧を取得するVBAの使用例と解説・Dir関数の関連記事

同じテーマ「VBA100本ノック」の記事

23本目：シート構成の一致確認
 24本目：全角英数のみ半角
 25本目：マトリックス表をDB形式に変換
26本目：ファイル一覧作成
27本目：ハイパーリンクのURL
28本目：シートをブックに分割
 29本目：画像の挿入
 30本目：名札作成（段組み）
31本目：入力規則
 32本目：Excel終了とテキストファイル出力
 33本目：マクロ記録の改修

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門

ホーム
マクロVBA入門編
VBA100本ノック
26本目：ファイル一覧作成

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBA練習問題
VBA100本ノック 26本目：ファイル一覧作成