EXCEL VBAフォルダ配下のファイル削除したい

質問

お世話になります。

VBAを使って特定フォルダ(C/TEST)配下のファイルを全て一括削除したいのです。
：特定フォルダ=C/TEST

やりたいこと
EXCELシートに[削除]というボタンを配置してクリックしたらC/TEST配下のファイルを全て
削除するロジックをどなたかご教授いただけますでしょうか？
C/TEST配下にファイルがない場合は[削除対象ファイルは存在しません]というメッセージを出して処理を終えたいです。

よろしくお願い致します。

EXCEL2013

回答No.1

real beatin（@realbeatin） · ベストアンサー

こんにちは。

例えば、C:\TESTにサブフォルダがある場合はどうしましょう？
どうにでもなるようにFSOで書いてみました。
必要に合わせて、コード内容を、
そちらで確認しながら、取捨してください。

' ' ★参照設定：Microsoft Scripting Runtime　/　Scripting
' ' 参照設定した場合は、★の行の型宣言を変更
Sub test()
Dim oFSO As Object　'　As Scripting.FileSystemObject　★
Dim oFold As Object　'　As Scripting.Folder　★
Dim oSubFold As Object　'　As Scripting.Folder　★
Dim oFile As Object　'　As Scripting.File　★
Dim tnFiles As Long
Dim tnSubFolds As Long
　　Set oFSO = CreateObject("Scripting.FileSystemObject")
　　Set oFold = oFSO.GetFolder("C:\TEST")

　　tnFiles = oFold.Files.Count
　　tnSubFolds = oFold.SubFolders.Count

　　' ' > C/TEST配下にファイルがない場合は[削除対象ファイルは存在しません]というメッセージを出して処理を終えたいです。
　　If tnFiles = 0 Then
　　　　MsgBox "[削除対象ファイルは存在しません]"
'　　　　Exit Sub
　　End If

　　' ' "C:\TEST"配下の　ファイルをすべて削除
　　For Each oFile In oFold.Files
　　　　oFile.Delete
　　Next

　　' ' "C:\TEST"配下の　サブフォルダを総当たりループ
　　For Each oSubFold In oFold.SubFolders
　　　　' ' 例１■"C:\TEST"配下の　サブフォルダ配下の　ファイルをすべて削除（サブフォルダは残す）
　　　　For Each oFile In oFold.Files
　　　　　　oFile.Delete
　　　　Next
　　　　' ' 例２■"C:\TEST"配下の　サブフォルダ（中身も一緒に）削除
　　　　oSubFold.Delete
　　Next

　　Set oFold = Nothing:　　 Set oFSO = Nothing
End Sub

お礼

realbeatinさん、ご連絡ありがとうございました！

ご教授いただきましたロジックで完璧にやりたいことが実現できました。
いつも分かり易いコメントを入れていただきまして本当にありがとうございます！！
今回も本当に助かりました！
ありがとうございました！！

回答No.3

keithin

＞特定フォルダ(C/TEST)配下のファイルを全て一括削除したい

サブフォルダは存在しない（無視の）前提で

sub macro1()
　dim myFile as string
　myFath = "c:\test\*.*"

　if dir(myfile) = "" then
　　msgbox "NOTHING FOUND"
　else
　　kill myfile
　　msgbox "DONE"
　end if
end sub

お礼

keithinさん、ご連絡ありがとうございました！
いつもすぐにご連絡いただきまして本当にありがとうございます。

ご教授いただきましたロジックで完璧にやりたいことが実現できました。
今回も本当に助かりました！
ありがとうございました！！

回答No.2

real beatin（@realbeatin）

＃１です。追加レスです。

サブフォルダをまったく意識しなくて良い、
という条件が確認出来る場合、ならば、
もう少し易しい方法もあります。
動作確認や、編集、加筆、については慎重に！

' ' Dir()関数版（直下のファイルのみ削除）
Sub test2()
Dim sCurDir As String
Dim sTemp As String
　　sCurDir = CurDir()　'　現在のフォルダをメモ
　　ChDrive "C"　'　ドライブを変更
　　ChDir "C:\TEST"　'　フォルダを変更
　　sTemp = Dir("*")　'　Dir()関数で　"C:\TEST"配下の　ファイル名を検索
　　If sTemp = "" Then　'　Dir()関数の戻り値が空文字　ならば
　　　　MsgBox "[削除対象ファイルは存在しません]"
　　　　Exit Sub
　　End If
　　Do While sTemp <> ""　'　Dir()関数の戻り値が空文字　でなければ
'　　　　Debug.Print sTemp
　　　　Kill sTemp　'　見つかったファイル名を指定して削除
　　　　sTemp = Dir()　'　Dir()関数　次を検索
　　Loop
　　ChDrive Left$(sCurDir, 1)　'　ドライブを元に戻す
　　ChDir sCurDir　'　現在のフォルダを元に戻す
End Sub