本日の動画ではファイルシステムオブジェクトを使ってこの『English Words』というフォルダーの中にある『TOFLE単語』というこの子フォルダーを操作します。
そしてこの子フォルダー『TOFLE単語』の中には、10個のフォルダーがつまり孫フォルダーがあります。

それぞれ音声データが入っている（mp3）ということ設定です。設定は前回の動画と同じです。
ただし、今回はmp3ファイルを上の階層に上げてやるというのではなくて、フォルダーの中に入ったままでいいけれども、どのフォルダーにどのファイルが入っているかを一覧にしたいということです。 その一覧表については、まずシート上にフォルダ名、ファイル名の列挙の形で表示する。
さらに、フォルダ内にも、一覧表を作成するというものです。

イメージがつかめないと思いますので、先にプログラムを実行します。
フォルダの選択ダイアログが表示されます。ユーザーは一覧を作成したい親フォルダを選択します。

フォルダを選択すると、ファイルリストという名前のシート上にファイルの一覧が作成されます。
また、ファイル一覧はテキストでも作成されます。

ファイル一覧.textは、親フォルダの『TOFLE単語』直下に作成されています。

今回も、前回同様、事前バインディングをしておきます。
FileSystemObjectを使うには、[MicroSoft Scripting Runtime] への参照設定を行う必要があります。
VBEを開きから以下のステップで参照設定を行います。：
1.メニューのツールをクリックします。
2.ツールの参照設定をクリックします。
3.表示される参照可能なライブラリから、「Microsoft Scripting Runtime」を探し、 4.「Microsoft Scripting Runtime」の左にあるチェック欄にチェックを入れます。OKをクリックして閉じます。
以上で FileSystemObjectを利用できるようになります。

ではコードを見てみましょう。
最初にコメントアウトしてあるコードは、事前バインディングできないケースの、CreateObjectメソッドを使ったFileSystemObjectを使うためのObjectを作成するコードです。

変数について説明します。
親フォルダは、 Dim ParentFolder As Object,
子フォルダ、 ChildFolder As Object,
ファイル、File As Object
選択したフォルダへのパス、Dim sParentFolderPath As String
ファイル一覧作成するためのリスト、 Dim sList As String,
ファイル一覧表テキストの名前、 txtFileName As String
シートに出力する行、Dim r As Long '
対象のシート、 Dim ws As Worksheet

以下のコードは、このファイル一覧が繰り返し使われる可能性を考えて入れています。
たとえば、どんどんファイルがふえていく可能性のある画像フォルダや、移動があるフォルダに対して一覧を作成するケースが考えられます。

Dim FSO As New FileSystemObject
変数fsoをFileSystemObjectのobjectとして宣言し、インスタンス化しています。
次にWith文を使って、親フォルダの選択をユーザーにしてもらいます。

   With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "親フォルダを選択してください"
        If .Show = -1 Then
            sParentFolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

親フォルダを選択したことで、フォルダーのパスが取得できますから、パスにつなげてテキストファイル名の設定をします。

    ' テキストファイル名の設定
    txtFileName = sParentFolderPath & "\ファイル名一覧.txt"

    Set ParentFolder = FSO.GetFolder(sParentFolderPath)
    For Each ChildFolder In ParentFolder.SubFolders
        Dim Cname As String
        Cname = "【" & ChildFolder.Name & "】"  ' 子フォルダ名を変数に格納
        ' 子フォルダ名をシートに追加
        ws.Cells(r, 1).Value = Cname
        sList = sList & Cname & vbCrLf
        r = r + 1 ' シートに次の行に移動

For Each ChildFolder In ParentFolder.SubFolders
For Each...Next ステートメントを使って、ParentFolder.SubFoldersから、一つずつ ChildFolder を取り出します。
ChildFolder の名前を変数Cnameに設定します。

そのCnameをシートのws.Cells(r, 1).Value　に転記します。
sList = sList & Cname & vbCrLf　で、sList　にCname フォルダ名を追加します。

For Each...Next ステートメントを使って、ChildFolderから、一つずつファイルを取り出して、その名前を
ws.Cells(r, 1).Value = File.Nameに転記します。

sList = sList & File.Name & vbCrLf　で、 取得したファイル名をsList追加します。
このようにして、繰り返し子フォルダを全部取得し、その中のファイル名を転記したり、リストに追加したりします。

最後にテキストを作成するための変数Dim ts As Objectを宣言し、
Set ts = FSO.CreateTextFile(txtFileName, True)
テキストファイルを作成します。 ts.Write sList　 tsにsListを書き込み、
ts.Close　tsを閉じます。
最後に終了したことを MsgBox でユーザーに報告します。

以上がコードの解説です。
以下が今回紹介した動画「親フォルダ内の子フォルダにあるファイル名を取得して一覧を作成し、Txt保存。　」のコード全体です。

'==============================================================
'=指定親フォルダ内の子フォルダにあるファイル名を取得して一覧を作成し、Txt保存。　　　シートにも一覧を作成する。
'==============================================================

Sub 子フォルダのファイルリスト作成()
    Dim ParentFolder As Object, ChildFolder As Object, File As Object
    Dim sParentFolderPath As String
    Dim sList As String, txtFileName As String
    
    Dim r As Long ' シートに出力する行
    Dim ws As Worksheet

    ' リストシートを初期化
    Set ws = ThisWorkbook.Sheets("FileList") ' "FileList"というシートを作成
    ws.Range("A:A").Clear ' 既存の内容をクリア
    r = 1

    Dim FSO As New FileSystemObject
    ' 親フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "親フォルダを選択してください"
        If .Show = -1 Then
            sParentFolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' テキストファイル名の設定
    txtFileName = sParentFolderPath & "\ファイル名一覧.txt"

    Set ParentFolder = FSO.GetFolder(sParentFolderPath)
    For Each ChildFolder In ParentFolder.SubFolders
        Dim Cname As String
        Cname = "【" & ChildFolder.Name & "】"  ' 子フォルダ名を変数に格納
        ' 子フォルダ名をシートに追加
        ws.Cells(r, 1).Value = Cname
        sList = sList & Cname & vbCrLf
        r = r + 1 ' シートに次の行に移動
    
        ' 子フォルダ内の各ファイルを取得
        For Each File In ChildFolder.Files
            ws.Cells(r, 1).Value = File.Name
            sList = sList & File.Name & vbCrLf
            r = r + 1 ' シートに次の行に移動
        Next File
            sList = sList & vbCrLf ' 空行を追加
    Next ChildFolder

    Dim ts As Object    ' テキストファイルにリストを書き込み
    Set ts = FSO.CreateTextFile(txtFileName, True)
    ts.Write sList
    ts.Close

    MsgBox "ファイルの一覧が作成されました。", vbInformation
End Sub