arrays - 使用VBA将循环中的多个值提供给数组

Question

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

目标:我正在定义没有维度的数组，因为我不知道将有多少文件输入其中。对于满足条件的每个文件，我试图获取 3 个值(名称、路径、日期)并添加到数组中。每个文件都将添加到数组的新行中。

前任。数组:

如果 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

Answer 1

我会使用字典和“类”，如下例所示。
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