FSO 指定フォルダ指定ファイル削除・このサンプルでは[Thumbs.db]を削除しています。

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][FSO 指定フォルダ指定ファイル削除・このサンプルでは[Thumbs.db]を削除しています。]

Sub 指定フォルダ指定ファイル削除()
'***********************************
'指定フォルダ指定ファイル削除
'***********************************
'指定フォルダ内のファルダを含むフォルダ内の特定ファイルを削除する
'指定フォルダを含む2階層まで検索
'このサンプルでは[Thumbs.db]を削除しています。

Dim strFilePath As String
Dim objFSO As Object
Dim strOpenPath As String
Dim objFolder As Object
Dim objSubFolder As Object
Dim objFile As Object
Dim strFileName As String
Dim GetFileName As String
Dim lngCnt As Long

GetFileName = "Thumbs" '検索するファイル名

lngCnt = 0
strOpenPath = ThisWorkbook.Path

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strOpenPath)

    'フォルダ直下
    For Each objFile In objFolder.Files
        strFilePath = objFile.Path
        strFileName = objFSO.GetFileName(strFilePath)
            If InStr(1, strFileName, GetFileName) <> 0 Then
                If MsgBox(strFilePath & vbNewLine & "Delete?", vbOKCancel, strFileName) = vbOK Then
                lngCnt = lngCnt + 1
                '[Kill]関数では"Thumbs.db"等の特殊ファイルは削除不可
                    objFSO.GetFile(strFilePath).Delete
                End If
            End If
    Next

    'サブフォルダ
    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            strFilePath = objFile.Path
            strFileName = objFSO.GetFileName(strFilePath)
                If InStr(1, strFileName, GetFileName) <> 0 Then
                    If MsgBox(strFilePath & vbNewLine & "Delete?", vbOKCancel, strFileName) = vbOK Then
                    lngCnt = lngCnt + 1
                    '[Kill]関数では"Thumbs.db"等の特殊ファイルは削除不可
                        objFSO.GetFile(strFilePath).Delete
                    End If
                End If
        Next
    Next

Set objFSO = Nothing

MsgBox "処理終了" & vbNewLine & lngCnt & " 個のファイルを削除しました。", 0, "処理終了"

End Sub







Production Japan Import Application. Since 1998