FSO サブフォルダ含めすべて取得

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][FSO サブフォルダ含めすべて取得]
Sub GetFolderAndFile()
'*****************************************************************
'指定したディレクトリ内のすべてのサブフォルダ及びファイルを取得
'*****************************************************************
'*2層以下は取得しません
'*Visual Basic 6.0 及び VBA
'*Microsoft Scripting Runtime(FSO)要参照設定
'EXCEL.BOOK新しいシートを追加しそこに列挙

Dim sht As Worksheet
Dim lIndex As Long
Dim hFolder As Folder
Dim subFolder As Folder
Dim Fso As FileSystemObject
Dim hFile As File
Dim iFolder As Folder

Set Fso = New FileSystemObject
Set hFolder = Fso.GetFolder(ThisWorkbook.Path & "\")
Set sht = ThisWorkbook.Worksheets.Add

With sht
'1.直下のファイル名取得(この場合このコードが実装されているファイル名が入る)
    lIndex = 1
        For Each hFile In hFolder.Files
            .Cells(lIndex, 1).Value = hFile.Name 'ファイル名のみの場合
            lIndex = lIndex + 1
        Next hFile

'2.直下のフォルダ名及びファイル名取得
        For Each subFolder In hFolder.SubFolders
            .Cells(lIndex, 2).Value = "[" & subFolder.Name & "]"
            lIndex = lIndex + 1
            Set iFolder = Fso.GetFolder(subFolder.Path & "\")
                For Each hFile In iFolder.Files
                    .Cells(lIndex, 3).Value = hFile.Name
                    lIndex = lIndex + 1
                Next hFile
            Set iFolder = Nothing
        Next subFolder
End With

Set Fso = Nothing
Set subFolder = Nothing
Set hFolder = Nothing
Set hFile = Nothing
Set sht = Nothing

End Sub






Production Japan Import Application. Since 1998