Excel VBA でサブフォルダ含むファイル名取得

Question

勉強不足で申し訳ないですが、以下の処理をExcel VBAでやるにはどうしたらいいでしょうか？
仮に「C:\aaa」をルートフォルダとします。そのルートフォルダ下には「2008年」「2009年」など年の名前を付けたフォルダだけがあり、他に余計なファイル等はありません。そして、その「2008年」など年の名前のフォルダに、雑多なファイルが入っています。大雑把に図にすると、次のような感じです。

C:\aaa
├2008年
│ ├a1.pdf
│ └a2.pdf
│
└2009年
　　├b5.pdf
　　└b6.pdf

そして、添付の図のように、A列には「2008年」などサブフォルダ名が、B列には「a1」などファイル名が出力されるようにしたいのです。なお、
(1)B列のファイル名の拡張子は、消えれば最高ですが、別に消えなくてもいいです。
(2)B列のファイル名をクリックするとファイルが開けるハイパーリンクがあると、嬉しいです。別になくてもいいです。

earthkun14 · Accepted Answer

Sub test()
Dim fso As FileSystemObject, fol As Folder, sfol As Folder, f As File
Dim ws As Worksheet
Dim rn As Range
Dim fn As String

Set fso = CreateObject("scripting.filesystemobject")
Set fol = fso.GetFolder(ThisWorkbook.Path)
Set ws = ActiveSheet
Set rn = ws.Cells(2, 1)
For Each sfol In fol.SubFolders
 For Each f In sfol.Files
  rn.Value = sfol.Name
  fn = Left(f.Name, InStr(1, f.Name, ".") - 1)
  ws.Hyperlinks.Add anchor:=rn.Offset(, 1), Address:=f.Path, TextToDisplay:=fn
  Set rn = rn.Offset(1)
 Next
Next
  
End Sub

参照設定で、Microsoft Scripting Runtimeを参照させてから実行してください。
アクティブシートのA2から、フォルダ名とファイル名・ハイパーリンク付を書き出します。
ただし、サブフォルダ内にフォルダがないことが前提です。

kmetu · Answer

> どうもそのサイトでは、「サブフォルダ名を取得する」とかは分かっても、「サブフォルダの名前およびその中にあるファイル名を取得する」ことが分かりにくいのです。

サブフォルダ名を取得してそれを変数に入れておき
その変数を利用して
サブフォルダを指定したDIRを使ってファイル名一覧を取得
をサブフォルダ分ループすればできませんか？

以下のsssの部分をサブフォルダ名を取得した
配列変数にしてループさせてください。

Sub Sample20()
    Dim buf As String, i As Long
    
    Dim sss As String
    
    sss = "D:\"
    buf = Dir(sss & "*.*")
    Do While buf <> ""
        i = i + 1
        Worksheets("Sheet1").Cells(i, 1) = sss
        Worksheets("Sheet1").Cells(i, 2) = buf
        buf = Dir()
    Loop
End Sub

kmetu · Answer

Dir関数でサブフォルダを取得する
http://officetanaka.net/excel/vba/tips/tips95.htm
ファイルの一覧を取得する
http://officetanaka.net/excel/vba/file/file07.htm

このあたりを参考にしてください。

Excel VBA でサブフォルダ含むファイル名取得

Sub test()

> どうもそのサイトでは、「サブフォルダ名を取得する」とかは分かっても、「サブフォルダの名前およびその中にあるファイル名を取得する」ことが分かりにくいのです。

Dir関数でサブフォルダを取得する

この回答への補足

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング