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

最終更新日：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の勉強用のサンプルとしてお使いください。