ファイル一覧取得

ファイル一覧取得

转自：【VBA】フォルダ内のサブフォルダとファイルの一覧を取得【FileSystemObjectを使う】
https://daitaideit.com/vba-fso-subfolder/

• ファイル一覧取得
• 全てのファイル一覧取得
• フォルダと全てのファイル一覧取得

具体は下記の通りです。

01.ファイル一覧取得

'======================
'Folder内FileをLoop
'getfolder(path).Files
'======================
Private Sub fileListGetButton_Click()

    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim path, B
    
    path = "D:\Workstation\VBA\20240601\testData"
    
    'Folder内FileをLoop
    For Each B In FSO.getfolder(path).Files
        Debug.Print B 'file path info
    Next


End Sub

实行效果：

02.全てのファイル一覧取得

'======================
'ALL fileList to get
'======================
Private Sub AllFileListGetButton_Click()
    Dim A
    A = "D:\Workstation\VBA\20240601\testData"
    
    Call TEST6(A)
End Sub

modules:
Sub TEST6(A)

    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim B
    'Folder内のFile Loop
    For Each B In FSO.getfolder(A).Files
        Debug.Print B
    Next
    
    Dim C
    'Folder内のsubFolder Loop
    For Each C In FSO.getfolder(A).subfolders
        '再帰する
        TEST6 (C)
    Next

End Sub

実行効果：

03.フォルダと全てのファイル一覧取得

注意：

在VBA中，参数传递的默认方式是Byref，因为本质想法是对于相同命名的参数，在系统中采用同一个数值。 所以，TEST8的参数i是ref引用，这个值 在迭代过程中用到的都是同一个ref的值，一直在稳步变更。

'======================
'fileList to get(subFolder included!)
'======================
Private Sub AllFolderFileListGetButton_Click()
    Dim A
    A = "D:\Workstation\VBA\20240601\testData"
    
    i = 1
    Call TEST8(A, i)
End Sub

modules:

Sub TEST8(A, i)
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    With ActiveSheet
        Dim B
        'Folder内のFile　Loop
        For Each B In FSO.getfolder(A).Files
            i = i + 1
            .Cells(i, 1) = A 'Folder Path
            .Cells(i, 2) = B 'File Path
            .Cells(i, 3) = FSO.getFilename(B)        'File name
            .Cells(i, 4) = FSO.getextensionname(B)   'File suffix
            .Cells(i, 5) = FSO.getfile(B).Size       'File size
            .Cells(i, 6) = FSO.getfile(B).datecreated
            .Cells(i, 7) = FSO.getfile(B).datelastmodified
            .Cells(i, 8) = FSO.getfile(B).datelastaccessed
        Next

        Dim C
        'Folder内のsubFolder　Loop
        For Each C In FSO.getfolder(A).subfolders
            i = i + 1
            .Cells(i, 1) = C 'Folder Path
            .Cells(i, 5) = FSO.getfolder(C).Size       'File size
            .Cells(i, 6) = FSO.getfolder(C).datecreated
            .Cells(i, 7) = FSO.getfolder(C).datelastmodified
            .Cells(i, 8) = FSO.getfolder(C).datelastaccessed
            '再帰する
            Call TEST8(C, i)
        Next
        
    End With

End Sub

実行効果：

04.区域セル内容のクリア

'======================
'Clear
'======================
Private Sub ClearButton_Click()
    ActiveSheet.Range("A2:H100").ClearContents
End Sub