どうもマサヤです!
コード説明不要!サクッとコードだけ知りたい or 使いたい方向けの記事です。
※他のコピペで使えるは記事はこちら!
さて今回は、「このフォルダ配下を全部取得して、階層化して、ハイパーリンクもつけたい!」
といった、わがまま要望をかなえるコードをお届けします。
仕事の説明資料の一つとして、フォルダを階層毎で表示して各フォルダ・ファイルを直接開けるようリンクを貼るシーンが本当にたまにですがあるんですよね。
必要がある度にコードを書くのが面倒・・・そこでVBAでサクッとコピペ解決できるようにしました!
【関連】ファイル一覧だけを取得したい!というアナタは↓をどうぞ!
【動画】コード実行した結果はこんな感じ
思っていた形と違うとなるといけませんので、まずはコードの実行結果を動画でご覧ください。
【これをコピペ!】フォルダ内の全取得し、階層・リンク化するコード
では、コードを紹介します。
Public findPath As String Sub GetFolderList() Dim fso As Object Dim cf As Variant Dim oRow, oCol As Integer findPath = "C:\Users\masay\Google ドライブ\ブログ" '←取得したいフォルダパスを指定する oRow = 2 '←出力開始の行を指定 oCol = 2 '←出力開始の列を指定 '指定フォルダを出力 Cells(oRow, oCol) = findPath ActiveSheet.Hyperlinks.Add anchor:=Cells(oRow, oCol), Address:=findPath Set fso = CreateObject("Scripting.FileSystemObject") Set cf = fso.GetFolder(findPath) 'フォルダ全探査 Call GetSubFolder(cf, oRow + 1, oCol) End Sub '=============================================================================== ' フォルダ単位で全探査 '=============================================================================== Sub GetSubFolder(cf, oRow, oCol) 'ファイル出力処理 For Each f In cf.Files fLevel = UBound(Split(Replace(f.Path, findPath, ""), "\")) Cells(oRow, oCol + fLevel) = f.Name Call lineDraw(oRow, oCol, fLevel) '罫線を引く ActiveSheet.Hyperlinks.Add anchor:=Cells(oRow, fLevel + oCol), Address:=f.Path 'ハイパーリンク化 oRow = oRow + 1 Next 'サブフォルダ処理 For Each f In cf.SubFolders fLevel = UBound(Split(Replace(f.Path, findPath, ""), "\")) Cells(oRow, oCol + fLevel) = f.Name Call lineDraw(oRow, oCol, fLevel) '罫線を引く ActiveSheet.Hyperlinks.Add anchor:=Cells(oRow, fLevel + oCol), Address:=f.Path 'ハイパーリンク化 oRow = oRow + 1 Call GetSubFolder(f, oRow, oCol) '再帰呼出 Next End Sub Sub lineDraw(oRow, oCol, fLevel) '罫線を引く For i = oCol + fLevel - 1 To oCol Step -1 If i = oCol + fLevel - 1 Then Cells(oRow, i) = ChrW(&H23BF) Else Cells(oRow, i) = "│" End If Cells(oRow, i).HorizontalAlignment = xlCenter Next End Sub
細かい所は後述しますが、9行目のフォルダパスを取得したいフォルダパスに変更すれば利用できます。
使用方法が解る方は、コードを自分好みにカスタマイズして利用してくださいね。
ハイパーリンクは不要の場合
下記コード部分(16・38・48行目)を削除 or コメント化することでハイパーリンク化しなくなります。
ActiveSheet.Hyperlinks.Add anchor:=Cells(oRow, oCol), Address:=findPath
ActiveSheet.Hyperlinks.Add anchor:=Cells(oRow, fLevel + oCol), Address:=f.Path 'ハイパーリンク化
罫線が不要の場合
下記コード部分(37・47行目)を削除 or コメント化することで罫線(⎿・│)が無くなります。
Call lineDraw(oRow, oCol, fLevel) '罫線を引く
コードの使用手順
VBE展開⇒標準モジュール追加⇒コードコピペで完了です。
動画や一連流れはこちらで確認できます。(別コードをコピーしていますが操作は一緒です)
まとめ
サブフォルダを含めた全フォルダ・ファイルを階層別に出力するコードをお届けしました!
ファイルが多くなるほどこの作業は時間を要し、ファイル数が数十個になれば数時間は余裕で消費されます。
単純作業で本当に時間の浪費なので、コードを使ってサクッと終わらせましょう!
そして、浮いた時間を他の仕事やプライベートに使ってくださいね。
コメント