Feeding multiple values in a loop to an array with VBA - arrays

Question

Scenario: I am reading through folders and subfolders of a directory, if the found file is an ".xls" it opens. I then run another condition that, if true, will try to pass some values to the array.
Objective: I am defining my array without dimensions, because I don't know how many files will feed into it. For each file that fulfills the conditions, I am trying to get 3 values (name, path, date) and add to the array. Each file would be added to a new row of the array.
Ex. of array:
If 3 files fulfill the condition...
name1 path1 date1
name2 path2 date2
name3 path3 date3
Issue: when I run, I get a subscript out of range error when I try to pass the values to the array. How can I fix that?
Code1: This starts the loop through folders
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
Code2: This gets the data:
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

I would use a dictionary and a "class" like in the following example.
The class fInfo looks like that
Option Explicit
Public fileName As String
Public filepath As String
Public fileDateCreated As Date
Then you could test it like that
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
In your code maybe like that
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

Answer 2

try with these steps:
1) temporarily size the array to the maximum number of files
2) keep track of found files
3) finally resize array to actual number of found files
As follows (I only show relevant snippet):
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
edit
BTW you can avoid the double nested writing loops and use a one shot statement:
w.Sheets("ControlSheet").Range("A1").Resize(UBound(outputarray, 1) + 1, UBound(outputarray, 2) + 1).Value = outputarray