スポンサーリンク
はじめに
下図のように、A社・B社など会社ごとのフォルダがあり、その中のサブフォルダ構成は共通というフォルダ構造を作ることは、よくあると思う。
そうしたとき、たとえば各社の「004_仕訳データ」フォルダだけに集中してアクセスしたいということも、あると思う。
そこで今回は、こういった場合に各サブフォルダやその中のファイルに、なるべく簡単にアクセスできるツールができないかと考え、作ってみた。(というか、私が仕事で使うことになりそうなので。)
そのExceツールは、こちらの場所に保存してある。
ツールの使用方法
まず今回のツールを、各サブフォルダの起点となるルートフォルダに保存する。
この、ツールの保存場所を読み込んで、それを起点としてファイル・サブフォルダの一覧を作成するものだ。
別に、ツールの保存場所に限らず任意フォルダを指定させることは普通にできるけど、その指定の手間とかも省きたいと思って、ツールの保存場所に限定することにした。
次に当ツールを開いてマクロを有効にする。
ボタンは３つだけ付けているが、各ボタンについて。
「ファイル一覧」ボタン
まず「ファイル一覧」ボタンを押すと、当ツールを保存したフォルダを起点として、サブフォルダまで含め全てのファイルの情報を一覧に出力する。
| 列 | 列名 | 説明 |
|---|---|---|
| B列 | フォルダパス | サブフォルダのフルパス。リンクも設定してあるので、そのセルをクリックすれば該当フォルダを開くことができる。 |
| C列 | フォルダ名 | サブフォルダの、パスではなくフォルダ名単体を抜き出したもの。冒頭で述べたような、「004_仕訳データ」フォルダだけに集中してアクセスしたいという場合に便利かと思う。 |
| D列 | ファイル名 | リンクも設定してあるので、そのセルをクリックすれば該当ファイルを開くことができる。 |
| E列 | 更新日時 | ファイルの更新日時 |
| F列 | サイズ | ファイルサイズ |
「サブフォルダ一覧」ボタン
「サブフォルダ一覧」ボタンは、「ファイル情報は要らないからサブフォルダの一覧だけ集約して一覧に出力する」という場合に使用する。
列の構成が、ファイル一覧の時とは少しだけ変わり、フォルダ内のファイル数といった情報を追加している。
| 列 | 列名 | 説明 |
|---|---|---|
| B列 | フォルダパス | サブフォルダのフルパス。リンクも設定してあるので、そのセルをクリックすれば該当フォルダを開くことができる。 |
| C列 | フォルダ名 | サブフォルダの、パスではなくフォルダ名単体を抜き出したもの。冒頭で述べたような、「004_仕訳データ」フォルダだけに集中してアクセスしたいという場合に便利かと思う。 |
| E列 | 更新日時 | フォルダの更新日時 |
| F列 | サイズ | フォルダサイズ |
| G列 | ファイル数 | フォルダ内のファイル数 |
「クリア」ボタン
「クリア」ボタンは文字通り、一覧のデータをクリアするだけ。
ソースコード
一応、今回のマクロのソースコードも書いておきます。
こういうサブフォルダの一覧とかいうやつになると「再帰処理」というものを使う。
再帰処理については、下記の記事などでも扱っている。
割と即興で書いたので、エラー処理とかは色々と甘いと思いますが、ひとまず間に合わせで使うくらいはできるかなと。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 |
Option Explicit '一覧表の列 Enum eItems no = 1 ' № strSubfolPath 'フォルダのパス strSubfolName 'フォルダ名 file_Name 'ファイル名 Date_LastModified '更新日時 file_Size 'サイズ filesCount 'ファイル数 fin End Enum '処理種別 Enum eSyori FileList 'ファイルの一覧 SubFoldersList 'サブフォルダの一覧 End Enum Dim ws As Worksheet Dim writeR As Long Dim cnt As Long Dim syori As Long 'ファイルの一覧 Sub make_FileList() syori = eSyori.FileList Call makeList End Sub 'サブフォルダの一覧 Sub make_SubFoldersList() syori = eSyori.SubFoldersList Call makeList End Sub Sub makeList() 'ファイル・サブフォルダの一覧を作成する Set ws = ActiveSheet Dim FSO As New FileSystemObject Dim rootFol As Folder '当ブックの場所 Set rootFol = FSO.GetFolder(ThisWorkbook.Path) writeR = 3 'シートの開始行 cnt = 0 'モジュール変数を初期化 Call appSet 'データ行を全て削除 Range(ws.Cells(writeR, 1), ws.Cells(Rows.Count, 1)).EntireRow.Delete Call loopProcess(rootFol) '再帰処理 ws.Cells(3, 1).Select ActiveWindow.ScrollRow = 1 Call appReset Select Case syori Case eSyori.FileList 'ファイルの一覧 'ファイル名を表示、ファイル数を非表示 ws.Columns(eItems.file_Name).Hidden = False ws.Columns(eItems.filesCount).Hidden = True If cnt = 0 Then MsgBox "ファイルはありません。", vbInformation, "ファイルなし" End If Case eSyori.SubFoldersList 'サブフォルダの一覧 'ファイル名を非表示、ファイル数を表示 ws.Columns(eItems.file_Name).Hidden = True ws.Columns(eItems.filesCount).Hidden = False If cnt = 0 Then MsgBox "サブフォルダはありません。", vbInformation, "サブフォルダなし" End If End Select End Sub Sub loopProcess(fol As Folder) 'サブフォルダに再帰処理を掛けていく Dim findFiles As files Dim eachFile As File Dim arr As Variant Dim rng As Range Dim strSubfolPath As String Dim strSubfolName As String With fol Set findFiles = .files 'サブフォルダ内ファイル strSubfolPath = .Path 'サブフォルダのパス strSubfolName = .Name 'サブフォルダの名前 End With Select Case syori Case eSyori.FileList 'ファイルの一覧 Dim filesCount As Long filesCount = findFiles.Count 'サブフォルダ内ファイルの数 If filesCount = 0 Then Else ReDim arr(1 To filesCount, 1 To eItems.fin - 1) Dim i As Long For Each eachFile In findFiles i = i + 1 cnt = cnt + 1 'モジュール変数なので再帰処理全体に渡って増えていく、 arr(i, eItems.no) = cnt '再帰処理全体でのファイルカウント arr(i, eItems.strSubfolName) = strSubfolName 'フォルダのパス arr(i, eItems.strSubfolPath) = strSubfolPath 'フォルダ名 arr(i, eItems.file_Name) = eachFile.Name 'ファイル名 arr(i, eItems.file_Size) = eachFile.Size / 1000 'サイズ arr(i, eItems.Date_LastModified) = eachFile.DateLastModified '更新日時 Next eachFile '配列の内容をシートに書き込み ws.Cells(writeR, 1).Resize(filesCount, eItems.fin - 1).Value = arr 'フォルダ・ファイルにリンクを設定していく For i = 1 To filesCount 'フォルダへのリンク Set rng = ws.Cells(writeR + i - 1, eItems.strSubfolPath) rng.Hyperlinks.Add Anchor:=rng, Address:=arr(i, eItems.strSubfolPath) 'ファイルへのリンク Set rng = ws.Cells(writeR + i - 1, eItems.file_Name) rng.Hyperlinks.Add Anchor:=rng, Address:=arr(i, eItems.strSubfolPath) ＆ "\" ＆ arr(i, eItems.file_Name) Next i '次のループ用 writeR = writeR + filesCount End If Case eSyori.SubFoldersList 'サブフォルダの一覧 ReDim arr(1 To 1, 1 To eItems.fin - 1) cnt = cnt + 1 'モジュール変数なので再帰処理全体に渡って増えていく、 arr(1, eItems.no) = cnt '再帰処理全体でのファイルカウント arr(1, eItems.strSubfolName) = strSubfolName 'フォルダのパス arr(1, eItems.strSubfolPath) = strSubfolPath 'フォルダ名 ' arr(i, eItems.file_Name) = eachFile.Name 'ファイル名 arr(1, eItems.file_Size) = fol.Size / 1000 'サイズ arr(1, eItems.Date_LastModified) = fol.DateLastModified '更新日時 arr(1, eItems.filesCount) = fol.files.Count 'フォルダ内のファイル数 '配列の内容をシートに書き込み ws.Cells(writeR, 1).Resize(1, eItems.fin - 1).Value = arr 'フォルダにリンクを設定 Set rng = ws.Cells(writeR, eItems.strSubfolPath) rng.Hyperlinks.Add Anchor:=rng, Address:=strSubfolPath '次のループ用 writeR = writeR + 1 End Select Dim subFol As Folder For Each subFol In fol.SubFolders Call loopProcess(subFol) '再帰処理 Next subFol End Sub Sub clearWs() Dim ws As Worksheet: Set ws = ActiveSheet 'データ行を全て削除 Range(ws.Cells(3, 1), ws.Cells(Rows.Count, 1)).EntireRow.Delete End Sub Sub appSet() 'マクロ処理中に、描画など余計なものを省略して高速化 With Application .ScreenUpdating = False '描画を省略 .Calculation = xlCalculationManual '手動計算 .DisplayAlerts = False '警告を省略。 End With End Sub Sub appReset() '描画などの設定をリセット With Application .ScreenUpdating = True '描画する .Calculation = xlCalculationAutomatic '自動計算 .DisplayAlerts = True '警告を行う End With End Sub |
スポンサーリンク
