ray88’s diary

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

指定されたフォルダ内のファイルパスを書き出す

Option Explicit
Sub TestGetArray()

    Dim arrayFiles() As String
    Dim strFolderPath As String
    Dim i As Integer
    Dim intIndexNum As Integer
    Dim intExcelRow As Integer
    
    strFolderPath = Sheets("Sheet1").Range("C2")
    
    arrayFiles = getFileArray(strFolderPath)
    
    intExcelRow = 5
    intIndexNum = 1
    
    For i = 0 To UBound(arrayFiles)
        With Sheets("Sheet1")
            .Cells(intExcelRow, 2) = intIndexNum
            .Cells(intExcelRow, 3) = arrayFiles(i)
            intIndexNum = intIndexNum + 1
            intExcelRow = intExcelRow + 1
        End With
    Next

End Sub

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

Dim FSO As Object
Dim tmpFile As Object
Dim objFiles As Object
Dim intFilesCount
Dim arrayFiles() As String
Dim i As Integer

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objFiles = FSO.GetFolder(strFolderPath).Files
    intFilesCount = objFiles.Count
    
    i = 0
    ReDim arrayFiles(intFilesCount - 1)
    
    With FSO.GetFolder(strFolderPath)
        For Each tmpFile In .Files
            arrayFiles(i) = tmpFile.Path
            i = i + 1
        Next
    End With
    getFileArray = arrayFiles()
End Function

Sub ClearTable()

Const intStartRow As Integer = 5
Dim intMaxRow As Integer

    With Sheets("Sheet1")
        intMaxRow = .Cells(Rows.Count, 2).End(xlUp).Row
        .Range(.Cells(intStartRow, 2), .Cells(intMaxRow, 3)).ClearContents
    End With

End Sub

f:id:ray88:20210403092811p:plain