Sub フォルダ名を取得する()

    フォルダ名 = Dir("C:\Sample\*.", vbDirectory)
    
    Do While フォルダ名 <> ""
    
        If フォルダ名 <> "." And フォルダ名 <> ".." Then 'ノイズを除外
            
            行 = 行 + 1 '上から順番に記録する
        
            Cells(行, "A") = フォルダ名
            
        End If
        
        フォルダ名 = Dir()
        
    Loop

End Sub