ray88’s diary

お仕事で困ったとき用の自分用の覚書

VBA 指定したフォルダ内のサブフォルダを取得する

■指定したフォルダパスのフォルダ内のサブフォルダを取得しパスを配列で返す
呼び出し元プロシージャ

Sub TestGetFolderArray()

    Dim arrayFolders() As String
    Dim strFolderPath As String
    Dim i As Integer
    
    strFolderPath = "C:\テスト"
    
    arrayFolders = getSubFolderArray(strFolderPath)
    
    For i = 0 To UBound(arrayFolders)
        Debug.Print arrayFolders(i)
    Next

End Sub

Functionプロシージャ

Function getSubFolderArray(strFolderPath As String) As String()
'----------------------------------------------------------
'機能  :指定したフォルダパスのフォルダ内のサブフォルダを取得する
'引数1 :対象フォルダパス
'戻り値 :取得したサブフォルダのパスを配列で返す
'----------------------------------------------------------

Dim FSO As Object
Dim subFolders As Object
Dim tmpFolder As Object
Dim intFolderCount As Integer
Dim arrayFolders() As String
Dim i As Integer

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set subFolders = FSO.GetFolder(strFolderPath).subFolders
    
    intFolderCount = subFolders.Count    
    
    i = 0
    ReDim arrayFolders(intFolderCount - 1)
    
    With FSO.GetFolder(strFolderPath)
    
        For Each tmpFolder In .subFolders
            arrayFolders(i) = tmpFolder.Name
            i = i + 1
'            ReDim Preserve arrayFolders(i)
        Next
        
    End With
    
    getSubFolderArray = arrayFolders()

End Function

f:id:ray88:20210228190504p:plain
ray88.hatenablog.com