テスト用のフォルダとダミーファイルを作成する

先日、指定パス直下のフォルダ名を取得する関数を作成した。
infoment.hatenablog.com
実際にこれを使ってテストするわけだが、その為のフォルダ及びファイル作成が、結構面倒だったりする。

そこで、テストの為のフォルダとファイルを自動生成するマクロを作成してみた。

今回作成するフォルダとファイルは、以下の通り。

1. 既存の「2016」「2017」「2018」直下に、各５個のフォルダを作成。
2. １．のフォルダは、Ａ社，Ｂ社・・・Ｏ社までの１５個。
3. ２．の各フォルダに、５個ずつテキストファイルを作成。

上記の一部を図示すると、下記のイメージとなる。

まず、フォルダを作成するマクロがこちら。

Option Explicit

Dim col As Collection
Dim FSO As New FileSystemObject
Const FolderPath As String = "C:\Temp"

Private Sub MakeTestFolder()
        If FSO.FolderExists(FolderPath) = False Then
            MsgBox "指定パスは存在しません。"
            Exit Sub
        End If
    Dim myFolder As Folder
    Dim FolderName As String
    Dim i As Long
    Dim Counter As Long
        Counter = 64
        For Each myFolder In FSO.GetFolder(FolderPath).SubFolders
            For i = 1 To 5
                FolderName = myFolder.Path & "\" & Chr(Counter + 1) & "社"
                FSO.CreateFolder FolderName
                Counter = Counter + 1
            Next
        Next
End Sub

Counter を一つずつ増やし、Chr関数で文字に変換することで、Ａ、Ｂ、Ｃという風にアルファベットが一つずつ変化させている。

次に、指定パス下のフォルダについて、全てのパスをコレクションに格納する。

Private Sub GetAllFolderPath(folder_path As String)
    Dim myFolder As Folder
        For Each myFolder In FSO.GetFolder(folder_path).SubFolders
            col.Add myFolder.Path
        Next

        For Each myFolder In FSO.GetFolder(folder_path).SubFolders
            Call GetAllFolderPath(myFolder.Path)
        Next
End Sub

繰り返しになるが、上記で使用した再帰呼び出しについては以下を参照されたし。
Office TANAKA - Excel VBA Tips[ファイルを検索する]

取得したフォルダのうち、サブフォルダを持つものはコレクションから除外する。

Private Sub GetBottomLevelFolder(folder_path As String)
    Set col = New Collection
    Call GetAllFolderPath(folder_path)
    Dim i As Long
        For i = col.Count To 1 Step -1
            If FSO.GetFolder(col.Item(i)).SubFolders.Count > 0 Then
                col.Remove i
            End If
        Next
End Sub

これにより、一番底（？）のフォルダだけが残る。なお、コレクションの最初から順にRemoveすると段違いが発生するので、一番最後から処理を行っている。

最後に、各フォルダにファイルを５つずつ作成する。

Private Sub MakeTestFiles()
    Dim c As Variant
    Dim FileName As String
    Dim FileCounter As Long
        FileCounter = 1
    Dim i As Long
        For Each c In col
            For i = 1 To 5
                FileName = c & "\TestFile_" & Format(FileCounter, "000") & ".txt"
                FSO.CreateTextFile(FileName).Close
                FileCounter = FileCounter + 1
            Next
        Next
End Sub

このように、作った直後に閉じているので、

FSO.CreateTextFile(FileName).Close

中身は空っぽだ。でも、15×5=75個もあるので、これを手作りするのは大変だ。

これらを、以下のマクロで実行した。

Sub test()
    Call MakeTestFolder
    Call GetBottomLevelFolder(FolderPath)
    Call MakeTestFiles
End Sub

結果は、以下の通り。

以上、テストのための下ごしらえでした。

参考まで。