VBAサンプル集
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
最終更新日:2017-04-08

フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除

VBAでフォルダを削除するにはRmDirステートメントを使いますが、


サブフォルダやファイルが入っている場合は、RmDirはエラーとなります、

そこで、サブフォルダやファイルがある場合は、FileSystemObjectを使います。


以下のサンプル使用時には、
「ツール」→「参照設定」で、「Microsoft Scripting Runtime」にチェックを付けてください。
参照設定しない場合は、
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
のように書き直してください。



Sub sample2()
  Dim objFSO As New FileSystemObject
  objFSO.DeleteFolder "フォルダのフルパス"
  Set objFSO = Nothing
End Sub


これで、サブフォルダもファイルも、一括で全て削除できます。


この場合の問題点としては、

・一つでも削除できないファイルがあるとエラーとなる
・サブフォルダのどれかがエクスプローラー等で開かれているとエラーとなる

等々、結構削除できない場合が発生します。

また、フォルダは消さずにサブフォルダ内も含めて全てのファイルを削除するといった事が出来ません。

そこでも独自にフォルダ削除を作成し、もう少し融通の利くフォルダ削除を作成してみました。

最下層からファィルを削除してからフォルダ削除を順次行うVBAになります。

'**********************************************************************
' sDir : 対象フォルダ
' sMsg : エラー発生時のメッセージ保存
' isOnlyFile : ファイルのみ削除する場合にTrue
'**********************************************************************
Function DelDir(ByVal sDir As String, _
        ByRef sMsg As String, _
        Optional ByVal isOnlyFile As Boolean = False) _
        As Boolean
  Dim objFSO As New FileSystemObject
  Dim objFolder As Folder
  sMsg = ""
  If Not objFSO.FolderExists(sDir) Then
    sMsg = "指定のフォルダは存在しません。"
    DelDir = False
    Exit Function
  End If
  Set objFolder = objFSO.GetFolder(sDir)
  Call DelDirectorys(objFolder, isOnlyFile, sMsg)
  If sMsg = "" Then
    DelDir = True
  Else
    DelDir = False
  End If
End Function
Sub DelDirectorys(ByVal objFolder As Folder, _
          ByVal isOnlyFile As Boolean, _
          ByRef sMsg As String)
  Dim objFolderSub As Folder
  Dim objFile As File
  On Error Resume Next
  For Each objFolderSub In objFolder.SubFolders
    Call DelDirectorys(objFolderSub, isOnlyFile, sMsg)
  Next
  For Each objFile In objFolder.Files
    objFile.Delete
    If Err.Number <> 0 Then
      sMsg = sMsg & "ファイル「" & objFile.Path & "」が削除できませんでした" & vbLf
      Err.Clear
    End If
  Next
  If Not isOnlyFile Then
    objFolder.Delete
    If Err.Number <> 0 Then
      sMsg = sMsg & "フォルダ「" & objFolder.Path & "」が削除できませんでした" & vbLf
      Err.Clear
    End If
  End If
  Set objFolderSub = Nothing
  Set objFile = Nothing
  On Error GoTo 0
End Sub


削除できないものがあっても、それは無視して次の削除を行うために、
エラー処理として、
On Error Resume Next
を組み込んでいます。
削除できなかったフォルダおよびファイルがあった場合は、
変数sMsgにその旨のメッセージを入れています。


使い方としては、以下のようになります。



Sub sample()
  Dim sMsg As String
  If DelDir(ThisWorkbook.Path & "\test", sMsg) Then
    MsgBox "削除終了"
  Else
    MsgBox sMsg
  End If
End Sub


ファイルのみ削除する場合は、
DelDir(ThisWorkbook.Path & "\test", sMsg, True)
として下さい。


使用するプロシージャーで、既にFileSystemObjectを生成していている場合は、
DelDirectorys
こちらを直接使ってもいでしょう。

このようなVBAコードが実際に必要になることは、そう多くは無いと思います。
いざという時の雛形として、またVBAの勉強用のサンプルとしてお使いください。



同じテーマ「マクロVBAサンプル集」の記事

Excel2003(xls)を2007以降(xlsx,xlsm)に変換する(HasVBProject)
ハイパーリンクからファイルのフルパスを取得する
ボタンのテキスト名のシートへ移動(Application.Caller)
Excelの表をPowerPointへ図として貼り付け
VBAで表やグラフをPowerPointへ貼り付ける
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除
Shift_JISのテキストファイルをUTF-8に一括変換
VBAコードの全プロシージャー・プロパティ一覧を取得
数式バーの高さを数式の行数で自動設定
図形オートシェイプ(Shape)の複数選択
GoogleスプレッドシートをExcelにインポートする


新着記事NEW ・・・新着記事一覧を見る

VBAのインデントについて|VBA技術解説(7月15日)
「VBA Match関数の限界」についての誤解|エクセル雑感(7月15日)
省略可能なVariant引数の参照不可をラップ関数で利用|VBA技術解説(7月12日)
100桁の正の整数値の足し算|エクセル雑感(7月9日)
LSetとユーザー定義型のコピー(100桁の足し算)|VBA技術解説(7月9日)
Variant仮引数のByRefとByValの挙動違い|エクセル雑感(7月5日)
Variant仮引数にRange.Valueを配列で渡す方法|エクセル雑感(7月5日)
Variantの数値型と文字列型の比較|エクセル雑感(7月1日)
VBAのVariant型について|VBA技術解説(6月30日)
VBAのString型の最大文字数について|エクセル雑感(6月20日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ