Arrays 使用VBA将循环中的多个值馈送到数组

场景：我正在读取目录的文件夹和子文件夹，如果找到的文件是.xls文件，它将打开。然后我运行另一个条件，如果为true，将尝试向数组传递一些值

目标：我正在定义没有维度的数组，因为我不知道有多少文件将传入其中。对于每个满足条件的文件，我将尝试获取3个值name、path、date和add到数组中。每个文件都将添加到数组的新行中

阵列的示例：

如果3个文件满足条件

name1    path1    date1
name2    path2    date2
name3    path3    date3

问题：当我运行时，当我尝试将值传递给数组时，会出现下标超出范围的错误。我怎样才能解决这个问题

代码1：这将启动通过文件夹的循环

Public Sub getInputFileInfo()
    Dim FileSystem As Object
    Dim HostFolder As String

    ' User selects where to search for files:
    HostFolder = GetFolder()

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)

End Sub

代码2：这将获取数据：

Public Sub DoFolder(Folder)

    Dim strFilename As String, filePath As String
    Dim dateC As Date
    Dim oFS As Object
    Dim outputarray() As Variant
    Dim ii As Long, lRow As Long, lCol As Long, lRow2 As Long
    Dim w2, w As Workbook
    Set w = ThisWorkbook

    ii = 1

    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next SubFolder
    Dim File
    For Each File In Folder.Files
        Set oFS = CreateObject("Scripting.FileSystemObject")
        'Set w2 = File

        filePath = File.Path
        strFilename = File.Name
        dateC = File.dateCreated
        If InStr(LCase(File.Path), LCase("xls")) <> 0 Then
            Set w2 = Workbooks.Open(filePath)
            For lRow2 = 1 To w2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
                If w2.Sheets(1).Range("A" & lRow2).Value = "Test Name" Then
                    outputarray(0, ii) = strFilename ' THE ERROR STARTS HERE
                    outputarray(1, ii) = filePath
                    outputarray(2, ii) = dateC
                    ii = ii + 1
                End If
            Next lRow2
            w2.Close False
        End If
        Set oFS = Nothing
    Next File

    For lRow = 1 To UBound(outputarray, 1)
        For lCol = 1 To UBound(outputarray, 2)
            w.Sheets("ControlSheet").Cells(lRow, lCol).Value = outputarray(lRow, lCol).Value
        Next lCol
    Next lRow

End Sub

尝试以下步骤：

1临时将数组大小调整为最大文件数

2跟踪找到的文件

3最后将数组调整为实际找到的文件数

如下所示，我仅显示相关片段：

ii = -1 '<<< initialize the counter fo found files to -1: it's more convenient for its subsequent updating and usage
ReDim outputarray(0 To 2, 0 To Folder.Files.Count) As Variant ' <<< temporarily size the array to the maximum number of files

For Each File In Folder.Files
    Set oFS = CreateObject("Scripting.FileSystemObject")
    'Set w2 = File

    filePath = File.Path
    strFilename = File.Name
    dateC = File.dateCreated
    If InStr(LCase(File.Path), LCase("xls")) <> 0 Then
        Set w2 = Workbooks.Open(filePath)
        For lRow2 = 1 To w2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            If w2.Sheets(1).Range("A" & lRow2).Value = "Test Name" Then
                ii = ii + 1 '<<< update the number of found files
                outputarray(0, ii) = strFilename
                outputarray(1, ii) = filePath
                outputarray(2, ii) = dateC
            End If
        Next lRow2
        w2.Close False
    End If
    Set oFS = Nothing
Next File

ReDim Preserve outputarray(0 To 2, 0 To ii) As Variant '<<< finally resize array to actual number of found files

---

我将使用字典和下面示例中的类。 fInfo类看起来是这样的

Option Explicit

Public fileName As String
Public filepath As String
Public fileDateCreated As Date

Sub AnExample()

Dim dict As New Scripting.Dictionary
Dim fInfo As fileInfo

Dim filepath As String
Dim strFilename As String
Dim dateC As Date
Dim i As Long

    For i = 1 To 2
        filepath = "Path\" & i
        strFilename = "Name" & i
        dateC = Now + 1

        Set fInfo = New fileInfo
        With fInfo
            .filepath = filepath
            .fileName = strFilename
            .fileDateCreated = dateC
        End With
        dict.Add i, fInfo
    Next i

    For i = 1 To dict.Count
        With dict.Item(i)
            Debug.Print .filepath, .fileName, .fileDateCreated
        End With
    Next i

End Sub

    For lRow2 = 1 To w2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        If w2.Sheets(1).Range("A" & lRow2).Value = "Test Name" Then
            Set fInfo = New fileInfo
            With fInfo
                .filepath = filepath
                .fileName = strFilename
                .fileDateCreated = dateC
            End With
            dict.Add ii, fInfo
'            outputarray(0, ii) = strFilename    ' THE ERROR STARTS HERE
'            outputarray(1, ii) = filepath
'            outputarray(2, ii) = dateC
'            ii = ii + 1
        End If
    Next lRow2

然后你可以这样测试它

Option Explicit

Public fileName As String
Public filepath As String
Public fileDateCreated As Date

Sub AnExample()

Dim dict As New Scripting.Dictionary
Dim fInfo As fileInfo

Dim filepath As String
Dim strFilename As String
Dim dateC As Date
Dim i As Long

    For i = 1 To 2
        filepath = "Path\" & i
        strFilename = "Name" & i
        dateC = Now + 1

        Set fInfo = New fileInfo
        With fInfo
            .filepath = filepath
            .fileName = strFilename
            .fileDateCreated = dateC
        End With
        dict.Add i, fInfo
    Next i

    For i = 1 To dict.Count
        With dict.Item(i)
            Debug.Print .filepath, .fileName, .fileDateCreated
        End With
    Next i

End Sub

    For lRow2 = 1 To w2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        If w2.Sheets(1).Range("A" & lRow2).Value = "Test Name" Then
            Set fInfo = New fileInfo
            With fInfo
                .filepath = filepath
                .fileName = strFilename
                .fileDateCreated = dateC
            End With
            dict.Add ii, fInfo
'            outputarray(0, ii) = strFilename    ' THE ERROR STARTS HERE
'            outputarray(1, ii) = filepath
'            outputarray(2, ii) = dateC
'            ii = ii + 1
        End If
    Next lRow2

在你的代码中可能是这样的

Option Explicit

Public fileName As String
Public filepath As String
Public fileDateCreated As Date

Sub AnExample()

Dim dict As New Scripting.Dictionary
Dim fInfo As fileInfo

Dim filepath As String
Dim strFilename As String
Dim dateC As Date
Dim i As Long

    For i = 1 To 2
        filepath = "Path\" & i
        strFilename = "Name" & i
        dateC = Now + 1

        Set fInfo = New fileInfo
        With fInfo
            .filepath = filepath
            .fileName = strFilename
            .fileDateCreated = dateC
        End With
        dict.Add i, fInfo
    Next i

    For i = 1 To dict.Count
        With dict.Item(i)
            Debug.Print .filepath, .fileName, .fileDateCreated
        End With
    Next i

End Sub

    For lRow2 = 1 To w2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        If w2.Sheets(1).Range("A" & lRow2).Value = "Test Name" Then
            Set fInfo = New fileInfo
            With fInfo
                .filepath = filepath
                .fileName = strFilename
                .fileDateCreated = dateC
            End With
            dict.Add ii, fInfo
'            outputarray(0, ii) = strFilename    ' THE ERROR STARTS HERE
'            outputarray(1, ii) = filepath
'            outputarray(2, ii) = dateC
'            ii = ii + 1
        End If
    Next lRow2

---

您需要使用，但我可能更喜欢另一种数据结构，如字典或集合。或字典集合！每次都有三个要关联值的键。使用数组的思想，我会在rows参数中增加值，并将columns保持为0,1,2的常量。另外，使用计数器变量在开始时过大，在结束时重拨。@Storax我怎么做？你怎么做？我提供的链接中描述了如何使用Redim。@Storax抱歉，我应该指定更好的。在这种情况下，我如何使用字典？另外，我现在正在尝试redim，但由于某些原因，数组维度正在失去控制