[ExcelVBA] 指定されたフォルダ以下のゴミ掃除

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧

■お題
指定されたフォルダ以下のゴミ掃除(問題出典：どう書く？org)
- 問題詳細 -

指定したフォルダ以下にある、ファイル名が"~"で終わるファイルを削除するプログラムを作ってください。 指定したフォルダの中にあるフォルダのさらに中にあるファイルも削除の対象です

■解答例
まずは、指定したフォルダ以下の全てをフォルダを調べる必要がありますね。
それに関しては、以前SampleCodeで「指定したフォルダ配下の全てのフォルダを調べる」で書いたのでそれをそっくり使いましょう。フォルダの走査については、上記リンクを参照してください。

上記で書いたものは、GetAllFolderPathという関数に対し、あるフォルダのパスを引数に渡すと返り値として配列が帰ってきて、各要素のフォルダのフルパスが格納されています。よって、フルパスがわかるとこまでは何もしなくてよいので、今度は各フォルダがわかったとこで、その中に入っているフォルダが何か？またファイル名がチルダ(~)で終わっている時削除する関数を書いてみます。

Sub DellFile(ByVal f As String)
    Dim FSO As New FileSystemObject
    Dim Folder As Folder, Files As Files, File As File
    Set Folder = FSO.GetFolder(f)
    Set Files = Folder.Files
    
    For Each File In Files
        If Len(File.Name) = InStrRev(File.Name, "~") Then
            Kill Pathname:=f & "\" & File.Name
        End If
    Next
End Sub

２行目：ファイルシステムオブジェクトを生成
３行目：Folder型、Files型、File型のオブジェクトの変数を宣言
４行目：引数で受け取るフォルダのフルパスをもとにGetFolderでフォルダの情報を取得
５行目：Folder内のファイルの情報を取得
７行目：For Each文でファイルを一つ一つ処理する。
８行目：ファイルの名前の長さとファイル名のチルダの位置(後ろから検索InStrRev)が一致するか判定
９行目：Kill関数にファイルパスを指定して削除する
１１行目：繰り返し

これと、フォルダの走査と組み合わせた全コードは下記の通り。

Option Explicit

Sub main()
    Dim FolderName As String, Result() As String
    FolderName = "C:\test"
    Result = GetAllFolderPath(FolderName)

    Dim f As Variant
    For Each f In Result
        DellFile (f)
    Next
End Sub

Sub DellFile(ByVal f As String)
    Dim FSO As New FileSystemObject
    Dim Folder As Folder, Files As Files, File As File
    Set Folder = FSO.GetFolder(f)
    Set Files = Folder.Files
    
    Dim position As Integer
    For Each File In Files
        If Len(File.Name) = InStrRev(File.Name, "~") Then
            Kill Pathname:=f & "\" & File.Name
        End If
    Next
End Sub

Function GetAllFolderPath(ByVal FolderName As String)
    Dim FolderPathList() As String, LastIndex As Integer
    LastIndex = -1
    Call GetFolderPath(FolderName, FolderPathList, LastIndex)
    If LastIndex = -1 Then
        GetAllFolderPath = Array("")
        Exit Function
    End If
    
    Dim i As Integer
    i = 0

    Do
        Call GetFolderPath(FolderPathList(i), FolderPathList, LastIndex)
        i = i + 1
    Loop While i < LastIndex

    GetAllFolderPath = FolderPathList
End Function

Sub GetFolderPath(ByVal FolderName As String, ByRef FolderPathList As Variant, ByRef LastIndex As Integer)
    Dim FSO As New FileSystemObject
    Dim Folders As Folders, Folder As Folder
    Set Folders = FSO.GetFolder(FolderName).SubFolders
    
    For Each Folder In Folders
        LastIndex = LastIndex + 1
        If LastIndex = 0 Then
            ReDim FolderPathList(LastIndex)
        Else
            ReDim Preserve FolderPathList(LastIndex)
        End If
        
        FolderPathList(LastIndex) = Folder.Path
    Next
End Sub

上記関数を使う部分を簡単めも
５行目：フォルダ名を指定してますね。
６行目：GetAllFolderPath関数にフォルダパスを渡し、配列で配下のフォルダパスを受け取る。
９行目：５行目で受け取ったフォルダパスの配列をForEachで展開。
１０行目：先程作ったDellFile関数にフォルダパスを渡し、その先で該当するファイルを削除する。
以上。

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] プログラミング問題一覧