Excel VBA質問箱 IV

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

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


13622 / 13645 ツリー ←次へ | 前へ→

【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 -

引用なし
パスワード
   こんばんは
或るフォルダに任意の名前でサブフォルダが不定数作成されていると仮定します。
空のサブフォルダが存在した場合、それを削除したいのですが、どのようにすれば良いでしょうか。
何方かご存知ならご教示ください。

実行前      実行後
A    =>  A
|        |
+Aa      +Aa
|        |
+Ab(空)   +Ad

+Ac(空)

+Ad

【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については勉強してみます。

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

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

再帰的な呼び出しかなんかが必要なのでしょうが、そういうプログラムを作った事がないのでよく分かりません。
上記のことが可能であればどのようにしたら実現できるのでしょうか。
難し過ぎますかね。。。

【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

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

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

ではではぁ

【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さんもありがとう御座いました。
また何かの時には宜しくお願いいたします。

13622 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free