Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13623 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【4531】空のサブフォルダを削除したい てと 03/3/25(火) 19:13 質問
【4551】Re:空のサブフォルダを削除したい BOTTA 03/3/26(水) 15:03 回答
【4557】Re:空のサブフォルダを削除したい てと 03/3/26(水) 18:58 質問
【4559】Re:空のサブフォルダを削除したい Kein 03/3/26(水) 21:25 回答
【4566】Re:空のサブフォルダを削除したい JuJu 03/3/27(木) 8:17 回答
【4573】Re:空のサブフォルダを削除したい BOTTA 03/3/27(木) 12:42 お礼
【4574】Re:空のサブフォルダを削除したい てと 03/3/27(木) 12:43 お礼
【4531】空のサブフォルダを削除したい
質問  てと  - 03/3/25(火) 19:13 -
引用なし
パスワード
   こんばんは
或るフォルダに任意の名前でサブフォルダが不定数作成されていると仮定します。
空のサブフォルダが存在した場合、それを削除したいのですが、どのようにすれば良いでしょうか。
何方かご存知ならご教示ください。

実行前　　　　　　実行後
Ａ　　　　＝＞　　Ａ
｜　　　　　　　　｜
＋Ａａ　　　　　　＋Ａａ
｜　　　　　　　　｜
＋Ａｂ（空）　　　＋Ａｄ
｜
＋Ａｃ（空）
｜
＋Ａｄ
【4551】Re:空のサブフォルダを削除したい
回答  BOTTA  - 03/3/26(水) 15:03 -
引用なし
パスワード
   てとさん、こんにちは。
FileSystemObjectの練習のため作ってみました。
空の判定は、サイズが0のもの。
従って、サブフォルダーの中に空のサブフォルダーが存在したり、
サイズ0のファイルが存在したりしても削除されてしまいます。
お試し下さい。

Sub aaa()
Dim FSO As Object, MyFolder As Object, MySubF As Object
Dim MyPath As String
　　MyPath = "C:\a"
　　Set FSO = CreateObject("Scripting.FileSystemObject")
　　Set MyFolder = FSO.GetFolder(MyPath)
　　For Each MySubF In MyFolder.SubFolders
　　　　If MySubF.Size = 0 Then MySubF.Delete
　　Next
　　Set MyFolder = Nothing: Set FSO = Nothing
End Sub
【4557】Re:空のサブフォルダを削除したい
質問  てと  - 03/3/26(水) 18:58 -
引用なし
パスワード
   BOTTA さん ありがとう御座いました。
早速試して見ました。
今考えている事には問題なく使えます。
FileSystemObjectについては勉強してみます。

ところで、以下のように拡張することは出来るでしょうか？

サブフォルダの中に空のサブフォルダと、サイズが１以上のファイルが存在した場合、空のサブフォルダを削除する。
サブフォルダの階層が深くても空のサブフォルダを見つけたらそれを削除する。

再帰的な呼び出しかなんかが必要なのでしょうが、そういうプログラムを作った事がないのでよく分かりません。
上記のことが可能であればどのようにしたら実現できるのでしょうか。
難し過ぎますかね。。。
【4559】Re:空のサブフォルダを削除したい
回答  Kein  - 03/3/26(水) 21:25 -
引用なし
パスワード
   ▼てと さん：
とりあえず2階層のテストフォルダーを作り、ループの中の判定を

For Each MySubF In MyFolder.SubFolders
　 If MySubF.Size = 0 Then
　　　MySubF.Delete
　 Else
　　　If MySubF.SubFolders.Count > 0 Then
　　　　 For Each SubFSub In MySubF
　　　　　　If SubFSub.Size = 0 Then
　　　　　　　 SubFSub.Delete
　　　　　　End If
　　　　 Next
　　　End If
　 End If
Next

のようにして、試してみたらどうでしょーか ?　このやり方だと深い階層までは
処理しきれない感じだけど、かと言って
>再帰的な呼び出し
これは失敗する可能性が高いと思いますが・・。
【4566】Re:空のサブフォルダを削除したい
回答  JuJu E-MAIL  - 03/3/27(木) 8:17 -
引用なし
パスワード
   てとさん、BOTTAさん、Keinさん、こんにちはぁ

>サブフォルダの階層が深くても空のサブフォルダを見つけたらそれを削除する。

私もよく使うので関数にしています。
　DeleteEmptyFolder "C:\FolderName"
のように呼び出してね。

' 空のフォルダを削除
Sub DeleteEmptyFolder(ByVal Folder As Variant)
　　Dim objSubFolder As Object
　　' 引数がフォルダオブジェクト以外のときはフォルダオブジェクトに変換する
　　If TypeName(Folder) <> "Folder" Then Set Folder = CreateObject("Scripting.FileSystemObject").GetFolder(CStr(Folder))
　　' サブフォルダがあれば再帰的に繰り返す
　　For Each objSubFolder In Folder.SubFolders
　　　　DeleteEmptyFolder objSubFolder
　　Next
　　' フォルダ内にファイルとフォルダがなければフォルダを削除する
　　If Folder.Files.Count + Folder.SubFolders.Count = 0 Then Folder.Delete
　　Set Folder = Nothing
End Sub

>サブフォルダの中に空のサブフォルダと、サイズが１以上のファイルが存在した場合、空のサブフォルダを削除する。

ファイルが存在したする空のサブフォルダ？？？

ではではぁ
【4573】Re:空のサブフォルダを削除したい
お礼  BOTTA  - 03/3/27(木) 12:42 -
引用なし
パスワード
   JuJuさん、Keinさん、てとさん、こんにちは。
Keinさん夜遅くに、JuJuさん朝早くに、フォローありがとうございます。

>再帰的に
と聞くと、今、プログラムが何回目の実行をしているのか？って考えていくうちに
頭が、こんがらがってしまうし、
Keinさんがおっしゃるように、
>失敗する可能性が高いと
も思うし、つい尻込みしてしまいます。

JuJuさんの関数、いただきま〜す。(^_^)
【4574】Re:空のサブフォルダを削除したい
お礼  てと  - 03/3/27(木) 12:43 -
引用なし
パスワード
   JuJu さん　ありがとう！

凄いですね、感激しています。
事の発端は写真の整理をすることを考えていたのです。
写真には幾つかの意味を持たせたファイル名を付けるのですが、
意味を持ったフォルダ名に分類したり、全部を階層なしのフォルダに戻して一覧したりとかを制御したかったのです。
JuJuさんのプログラムを使わせていだければ、自由自在に写真の整理が出来ますね。
本当にありがとう御座いました。

BOTTAさん、Keinさんもありがとう御座いました。
また何かの時には宜しくお願いいたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13623 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free