[[20200928170114]] 『フォルダの中のファイルを削除』(しのみや) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『フォルダの中のファイルを削除』(しのみや)

 【フォルダの構成】
 Dataフォルダ
  Aフォルダ
    → 1フォルダ
      ああ.zip
      いい
    → 2フォルダ
      ささ.zip
    → 3フォルダ
      たた.zip
      けけ

  Bフォルダ
    → 9フォルダ
      なな.zip
      かか.zip

  Cフォルダ
    → 5フォルダ
      うう.zip
     

 【どうしたいのか】
 A・B・Cフォルダとその下の1・2・3・9・5フォルダは残して、
 中のファイル(zipとは限らない)を削除したい

 Aフォルダ
    → 1フォルダ
    → 2フォルダ
    → 3フォルダ

 Bフォルダ
    → 9フォルダ

 Cフォルダ
    → 5フォルダ

 【試しているところ】
 インターネットからファイル削除の記述を拾ってきて、動きを確認しています

 Private Sub CmdSTART_Click()

      Dim fso As FileSystemObject
     Set fso = New FileSystemObject

     Dim fl As Folder

     Set fl = fso.GetFolder(ThisWorkbook.Path & "\Data\") ' フォルダを取得

     Dim f As file
     For Each f In fl.files ' フォルダ内のファイルを取得          ★
         If f.Name = "Tips.txt" Then ' 削除したいファイル
             f.Delete (True)         ' ファイルを削除
         End If
     Next

     ' 後始末
     Set fso = Nothing

     MsgBox "終了しました"

 End Sub

 ★の部分で、ファイルはないので終了してしまいます
 (実際には1・2・3・9・5のフォルダがあるところ)

 インターネットから拾ってきているものは、削除したいファイルが固定なので
 ファイル名を指定していますが、実際にはファイル名は決まっていません

 ファイル名をすべて取得してから削除をする、のでしょうか…

 (他にも質問させてもらっているものがありますが、
  確認・検証追いついていなくて回答がまだになっています
  後程回答させていただく様にします)

< 使用 Excel:Excel2010、使用 OS:Windows10 >


 簡単なのは、大元のフォルダを削除して、
 フォルダのみ再作成でしょうか。
(OK) 2020/09/28(月) 17:05

 Killステートメントとワイルドカードを組み合わせて、
 特定のフォルダ直下のファイルを一括で削除、という
 のも可能だったかと思います。※未検証。
(OK) 2020/09/28(月) 17:08

 あと、

 fso 再帰処理

 で過去ログ検索してみてください。
(OK) 2020/09/28(月) 17:11

コマンドプロンプトのRMDIRコマンドなら、引数指定する事で、ファイルの中身があっても強制削除できたりします。 なので、消すと決まっているフォルダの中身は全部消して良いなら、以下とか。
 Sub test()
    Dim cw As String

    With CreateObject("WScript.Shell")
        cw = .Exec("CMD /C RMDIR /S/Q ""c:\Aフォルダ\1フォルダ""").StdOut().ReadAll()
        cw = .Exec("CMD /C RMDIR /S/Q ""c:\Aフォルダ\2フォルダ""").StdOut().ReadAll()
        cw = .Exec("CMD /C MKDIR ""c:\Aフォルダ\1フォルダ""").StdOut().ReadAll()
        cw = .Exec("CMD /C MKDIR ""c:\Aフォルダ\2フォルダ""").StdOut().ReadAll()
    End With
 End Sub
(???) 2020/09/28(月) 17:25

 すみません…質問の書き方が悪かったです
 申し訳ないです…

 最終的に残したいと思っている
 Aフォルダ
     → 1フォルダ
     → 2フォルダ
     → 3フォルダ
  Bフォルダ
     → 9フォルダ
  Cフォルダ
     → 5フォルダ
 のフォルダ名は固定ではないです。

 固定ではないので、何が削除の判断の基準かと言いますと
 Detaフォルダ - Aフォルダ - 1フォルダ - ああ.zipと
 Dataフォルダから3つ目の階層ということです

 頂いた回答を勉強させてもらって、
 「大元のフォルダを削除して再作成の対応」で考えたことなのですが、

 先にフルパスを取得しておいて、
 2つ目の階層まで再作成といったことなのかな…とぼんやりと考えております
 方向は間違っていないでしょうか…

 fsoと回帰処理を調べてみました
 fso…FileSystemObject ドライブ・フォルダ・ファイルなどを操作できるオブジェクト
 回帰処理…自分自身を呼び出すプロシージャ
 (使いこなせるまではいかなさそうですが、理解はしました)
(しのみや) 2020/09/29(火) 11:48

私の案だと、指定したフォルダ以下、サブフォルダがあったとしても、全部消えますよ?
なので、例えば「Aフォルダ」を指定して全部消してから、新たにサブフォルダを好きなだけ作成するだけです。

決まっているのは親フォルダだけ、というのであれば、まずはDIRコマンドで指定フォルダ以下のサブフォルダ名を全部抜き出しておいてから、親フォルダ以下全部一回で消し、覚えていたフォルダ名毎に再作成すれば良いでしょう。
(???) 2020/09/29(火) 11:56


 こんな感じなんでしょうか?
 ダミーでテスト検証をよくしてください。
 慎重にやってください。

 Option Explicit
 Dim fso As Object
 Sub main()
     Dim p As String
     Dim fld As Object
     Set fso = CreateObject("Scripting.FileSystemObject")

     p = "D:\MyDocuments\202009\test1" 'rootフォルダ。■適宜修正して下さい。
     Set fld = fso.getfolder(p)
     Call myDelete(fld, 1)
 End Sub

 Sub myDelete(fld As Object, depth As Long)
     Dim subf As Object
     Dim f As Object

     For Each f In fld.Files
          f.Delete
      Next

      If depth <= 2 Then
          For Each subf In fld.SubFolders
              Call myDelete(subf, depth + 1)
          Next
      Else
          For Each subf In fld.SubFolders
              subf.Delete
          Next
      End If
  End Sub

(γ) 2020/09/29(火) 13:10


 ありがとうございます

 状況を理解するのと検証にずいぶん手間取りましたが…

 γさんの記述で希望の結果が得られました

 OKさんも???さんもお知恵を下さりありがとうございました

(しのみや) 2020/09/30(水) 11:04


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.