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

質問

勉強不足で申し訳ないですが、以下の処理を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列のファイル名をクリックするとファイルが開けるハイパーリンクがあると、嬉しいです。別になくてもいいです。

回答No.3

earthkun14 · ベストアンサー

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から、フォルダ名とファイル名・ハイパーリンク付を書き出します。
ただし、サブフォルダ内にフォルダがないことが前提です。

お礼

ありがとうございます。正にこれです。すごく助かりました。

回答No.2

kmetu

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

サブフォルダ名を取得してそれを変数に入れておき
その変数を利用して
サブフォルダを指定した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

回答No.1

kmetu

Dir関数でサブフォルダを取得する
http://officetanaka.net/excel/vba/tips/tips95.htm
ファイルの一覧を取得する
http://officetanaka.net/excel/vba/file/file07.htm

このあたりを参考にしてください。

お礼

えっと、補足に書いた
＞ VBAを行うExcelファイルは、例で言う「C:\aaa」フォルダにおいて

っていう文の「おいて」っていうのは、「保存して」という意味です。

補足

どうもそのサイトでは、「サブフォルダ名を取得する」とかは分かっても、「サブフォルダの名前およびその中にあるファイル名を取得する」ことが分かりにくいのです。なお、VBAを行うExcelファイルは、例で言う「C:\aaa」フォルダにおいて、フォルダの相対参照を利用したディレクトリ参照にしたいと思っています。