スポンサーリンク
はじめに
Windowsのエクスプローラでは、気付いたら、空のフォルダが幾つも残っていることがある。
フォルダの中にフォルダがマトリョーシカ式に入っているが、ファイルは何も無くて空のフォルダばかりになってるなんてことも、たまにある。
今回は、そういう空のフォルダを一括削除するExcelマクロを作成してみた。
サブフォルダまで探っていって、ファイルが1個も存在しないフォルダを削除していくものだ。
ソースコード
それではソースコード。
メイン処理の「deleteEmptyFolders」というやつを、個人用マクロブックにでも入れて使えば良いかと思う。
|
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 |
Option Explicit Sub deleteEmptyFolders() '空のフォルダを削除していく With Application.FileDialog(msoFileDialogFolderPicker) .Title = "空のフォルダを削除したい場所を選ぶ" If Not .Show Then Exit Sub '選択されたフォルダに対し再帰処理を掛けていく fncDeleteFolders (.SelectedItems(1)) End With End Sub Private Function fncDeleteFolders(initialPath) As Boolean Dim FilesCnt As Long 'フォルダ内のファイルの数 Dim foldersArr() As String 'フォルダ内のフォルダ一覧 Dim FoldersCnt As Long 'フォルダ内のフォルダの数 Dim findFileName As String Dim NewPath As String Dim i As Long FilesCnt = 0 'フォルダ内のファイルの数を0に FoldersCnt = 0 'フォルダ内のフォルダの数を0に ReDim foldersArr(0 To 0) 'フォルダ内のフォルダ一覧をクリア findFileName = Dir(initialPath ＆ "\*.*", vbDirectory) 'ファイル/フォルダの初期検索 Do While findFileName ＜> "" 'ファイル/フォルダが無くなるまで繰り返す 'Dirの返り値で、 '「.」→自フォルダ '「..」→1つ上のフォルダ If findFileName ＜> "." And findFileName ＜> ".." Then NewPath = initialPath ＆ "\" ＆ findFileName If (GetAttr(NewPath) And vbDirectory) = vbDirectory Then '検索したのがフォルダならフォルダ一覧の登録とフォルダ数のカウントアップ FoldersCnt = FoldersCnt + 1 'サブフォルダを配列へ ReDim Preserve foldersArr(0 To FoldersCnt) foldersArr(FoldersCnt) = NewPath Else '検索したのがファイルならファイル数のカウントアップ FilesCnt = FilesCnt + 1 End If End If findFileName = Dir '次のファイル/フォルダの検索 Loop '下位の各フォルダでの削除処理を行う For i = 1 To UBound(foldersArr) '再帰処理し、下位フォルダの削除を行う If fncDeleteFolders(foldersArr(i)) Then 'Trueなら、フォルダを削除し、フォルダ個数▲1 RmDir foldersArr(i) FoldersCnt = FoldersCnt - 1 End If Next i 'フォルダもファイルも無くなったらTrue '一方でも残っていたらFalseを返す If FoldersCnt ＜= 0 And FilesCnt ＜= 0 Then fncDeleteFolders = True Else fncDeleteFolders = False End If End Function |
解説等
今回のマクロは、実はかなり難しい項目をところどころ含む。
その難しい箇所だけを、簡単に触れていく。
再帰処理
「fncDeleteFolders 」という処理ファンクションでは、その中でもう一回「fncDeleteFolders 」と自分自身を呼び出す再帰処理というやつをやっている。
要は、サブフォルダが連なっていても無限に探っていくためのもので、これは別の記事でもちょっと扱っている。
Dir
「Dir」というやつは、ファイルやフォルダの存在状態を調べるやつで、これは割と重要なやつなので、また別の記事でも扱う。
Dirの返り値が
「.」なら自フォルダ
「..」なら1つ上のフォルダ
を示すなんていうのは、Dirをよく使う人でも中々お目にかかることは無いんじゃないだろうか。
GetAttrとビット演算・・・
などというコードがあるが、ここで使っているAndは、正確に言うとビット演算というやつで、かなり難しい。
VBAをやってる人でもそうは使うことがないだろうし、ガチ勢の人でもない限り厳密にこの処理の意味を考える必要はないかと思う。
次回の記事でちょっと説明を書いてみた。
正しく理解してる人からツッコミを入れられないように書けたか、自信はとても無い。
要はGetAttrというやつが属性(attribute)を取得するやつで、その結果としてフォルダvbDirectoryであるという属性を返してもらいたいわけだ。
でもそのフォルダvbDirectoryに、隠しファイルとかの追加属性が付いてたり付いてなかったりするのだけど、どっちにせよフォルダvbDirectoryって属性なんだよと一括りにして結果を取得したいからこんな書き方をしてるという感じだ。
その他
他には、配列の要素を再定義する
ReDim Preserve
とかを珍しく使用しているが、これについては↓の記事で少し触れている。
フォルダを削除するのには
RmDir
というやつを使っている。これがファイルの削除なら、物騒だが
Kill
で削除できる。
スポンサーリンク
