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

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

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

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

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

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

view plainprint?

1. Sub DellFile(ByVal f As String)  
2.     Dim FSO As New FileSystemObject  
3.     Dim Folder As Folder, Files As Files, File As File  
4.     Set Folder = FSO.GetFolder(f)  
5.     Set Files = Folder.Files  
6.       
7.     For Each File In Files  
8.         If Len(File.Name) = InStrRev(File.Name, "~") Then  
9.             Kill Pathname:=f & "\" & File.Name  
10.         End If  
11.     Next  
12. 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
    
    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関数にファイルパスを指定して削除する
１１行目：繰り返し

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

view plainprint?

1. Option Explicit  
2.   
3. Sub main()  
4.     Dim FolderName As String, Result() As String  
5.     FolderName = "C:\test"  
6.     Result = GetAllFolderPath(FolderName)  
7.   
8.     Dim f As Variant  
9.     For Each f In Result  
10.         DellFile (f)  
11.     Next  
12. End Sub  
13.   
14. Sub DellFile(ByVal f As String)  
15.     Dim FSO As New FileSystemObject  
16.     Dim Folder As Folder, Files As Files, File As File  
17.     Set Folder = FSO.GetFolder(f)  
18.     Set Files = Folder.Files  
19.       
20.     Dim position As Integer  
21.     For Each File In Files  
22.         If Len(File.Name) = InStrRev(File.Name, "~") Then  
23.             Kill Pathname:=f & "\" & File.Name  
24.         End If  
25.     Next  
26. End Sub  
27.   
28. Function GetAllFolderPath(ByVal FolderName As String)  
29.     Dim FolderPathList() As String, LastIndex As Integer  
30.     LastIndex = -1  
31.     Call GetFolderPath(FolderName, FolderPathList, LastIndex)  
32.     If LastIndex = -1 Then  
33.         GetAllFolderPath = Array("")  
34.         Exit Function  
35.     End If  
36.       
37.     Dim i As Integer  
38.     i = 0  
39.   
40.     Do  
41.         Call GetFolderPath(FolderPathList(i), FolderPathList, LastIndex)  
42.         i = i + 1  
43.     Loop While i < LastIndex  
44.   
45.     GetAllFolderPath = FolderPathList  
46. End Function  
47.   
48. Sub GetFolderPath(ByVal FolderName As String, ByRef FolderPathList As Variant, ByRef LastIndex As Integer)  
49.     Dim FSO As New FileSystemObject  
50.     Dim Folders As Folders, Folder As Folder  
51.     Set Folders = FSO.GetFolder(FolderName).SubFolders  
52.       
53.     For Each Folder In Folders  
54.         LastIndex = LastIndex + 1  
55.         If LastIndex = 0 Then  
56.             ReDim FolderPathList(LastIndex)  
57.         Else  
58.             ReDim Preserve FolderPathList(LastIndex)  
59.         End If  
60.           
61.         FolderPathList(LastIndex) = Folder.Path  
62.     Next  
63. End Sub  

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] プログラミング問題一覧