フォルダ（サブフォルダも全て）削除する、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の勉強用のサンプルとしてお使いください。