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

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.