VBA Excel: for each results into cells? counter not working?

Question

I´m creating a macro that crawls into subfolders and retrieve the name of some files. I used code from this answer to another question and works fine to get the results into the immediate window, but I want to get them into cells, as a list. What I get is just the result of the first iteration.

What I´m trying to do might be obvious, but I swear I tried and couldn´t find the answer by myself. For the record, I´m just starting to code.

My code here. The important part comes at the end, in Sub ListFiles(fld As Object, Mask As String).

Option Explicit

Sub Retrieve_Info()

Dim strPath As Variant
Dim pasta_destino As Range
Dim fle As String
Dim fso As Object 'FileSystemObject
Dim fldStart As Object 'Folder
Dim fld As Object 'Folder
Dim fl As Object 'File
Dim Mask As String

Set pasta_destino = ThisWorkbook.Worksheets("VINCULATOR").Range("pasta_destino")
strPath = Application.GetOpenFilename _
(Title:="Selecione o arquivo.xlsx", _
FileFilter:="Excel Files *.xlsx* (*.xlsx*),")

If Not strPath = False Then
pasta_destino = strPath
fle = Dir(strPath)

Set fso = CreateObject("scripting.FileSystemObject") ' late binding
'Set fso = New FileSystemObject 'or use early binding (also replace Object types)

Set fldStart = fso.GetFolder(Replace(strPath, fle, ""))
Mask = "*.xlsx"
For Each fld In fldStart.SubFolders
ListFiles fld, Mask
Next
End If
End Sub

Sub ListFiles(fld As Object, Mask As String)
    Dim fl As Object 'File
    Dim vrow As Integer
    Dim vinculadas As Range
    Dim n_vinc As Range
    Set vinculadas = ThisWorkbook.Worksheets("VINCULATOR").Range("vinculadas")
    Set n_vinc = ThisWorkbook.Worksheets("VINCULATOR").Range("n_vinc")
    vrow = 0
    For Each fl In fld.Files
       If fl.Name Like Mask And InStr(fl.Name, "completo") = 0 Then
       vrow = vrow + 1
            vinculadas.Cells(vrow, 1) = fld.Path & "\" & fl.Name
        End If
    Next
   n_vinc = vrow
End Sub

Please, help!

Answer 1

I have taken a slightly different approach which might be easier for you to follow in addition to executing faster. Please try this.

Sub SpecifyFolder()
    ' 10 Dec 2017

    Dim Fd As FileDialog
    Dim PathName As String
    Dim Fso As Object
    Dim Fold As Object, SubFold As Object
    Dim i As Long

    Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
    With Fd
        .ButtonName = "Select"
        .InitialView = msoFileDialogViewList
        .InitialFileName = "C:\My Documents\"       ' set as required
        .Show

        If .SelectedItems.Count Then
            PathName = .SelectedItems(1)
        Else
            Exit Sub                                ' user cancelled
        End If
    End With
    Set Fd = Nothing

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fold = Fso.GetFolder(PathName)
    ListFiles Fold, "*.xlsx"
    For Each SubFold In Fold.SubFolders
            ListFiles SubFold, "*.xlsx"
    Next SubFold
    Set Fso = Nothing
End Sub

Sub ListFiles(Fold As Object, _
              Mask As String)
    ' 10 Dec 2017

    Dim Fun() As String                             ' file list
    Dim Rng As Range
    Dim Fn As String                                ' file name
    Dim i As Long                                   ' array index

    ReDim Fun(1 To 1000)                            ' maximum number of expected files in one folder
    Fn = Dir(Fold.Path & "\")
    Do While Len(Fn)
        If Fn Like Mask And InStr(Fn, "completo") = 0 Then
            i = i + 1
            Fun(i) = Fold.Path & "\" & Fn
        End If
        Fn = Dir
    Loop

    If i Then
        ReDim Preserve Fun(1 To i)
        With ThisWorkbook.Worksheets("VINCULATOR")
            ' specify the column in which to write (here "C")
            i = .Cells(.Rows.Count, "C").End(xlUp).Row
            Set Rng = .Cells(i + 1, "C").Resize(UBound(Fun), 1)
            Application.ScreenUpdating = False
            Rng.Value = Application.Transpose(Fun)
            Application.ScreenUpdating = True
        End With
    End If
End Sub

As you see, I have dispensed with specifying a target range, just the sheet and the column (I chose column C; please change as required in the ListFiles sub). Note that the code appends new lists to the existing content of the indicated column.

There are two things the code doesn't do to my entire satisfaction. One, it doesn't write to the first row of an empty column C. Instead, it leaves the first row blank. You might actually like that. Two, It doesn't do sub-subfolders. File names are extracted only from the selected folder and its immediate subfolders. Additional programming would be required for either additional feature, if required.

Finally, I admit that I didn't test for correct transfer of the lists to the worksheet. I think it works correctly but you should check that the first and last names are listed in your worksheet column. They are extracted from the folder but perhaps their omission when writing to the sheet would be a typical error to occur in this particular method.