code - vba excel 2016

Listar archivos en la carpeta y subcarpeta con ruta al archivo.txt

Question

Esta pregunta ya tiene una respuesta aquí:

• obtener lista de subdires en vba 4 respuestas

Tengo una hoja de Excel que tiene una celda que contiene la ruta a un directorio, quiero una macro que busque en el directorio y en cualquier subdirectorio y enumere los archivos en un archivo .txt, con la ruta completa de cada archivo.

Esto es actualmente lo que he encontrado que parece que debería encontrar los archivos, excepto que la ruta está codificada y no hace nada con los resultados.

¿Alguna idea de cómo puedo cambiarla para que se ajuste a mis necesidades?

Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("C:/Work/NCL/nCLs/histogram_addition/TestData/Input/RTE/")
Do While Len(StrFile) > 0
Debug.Print StrFile
StrFile = Dir
Loop
End Sub

Answer 1

Aquí hay un método improvisado a partir de los ejemplos de FileSystemObject () usando una llamada recursiva. Aplique una clasificación a los resultados si es necesario. También puede filtrar por extensión .txt usando otros métodos FileSystemObject ():

 Sub Sample()
ShowFolderList ("C:/temp")
End Sub
Sub ShowFolderList(folderspec)
Dim fs, f, f1, fc, s, sFldr
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 In fc
If Right(f1, 1) <> "/" Then ShowFolderList f1 & "/" Else ShowFolderList f1
Next
Set fc = f.Files
For Each f1 In fc
Debug.Print folderspec & f1.Name
Next
End Sub

Escribir en el archivo:

 Option Explicit
Dim file As Object
Dim fs As Object
Sub go()
Set fs = CreateObject("Scripting.FileSystemObject")
Set file = fs.OpenTextFile("C:/temp2/results3.txt", 2, True) '' 2=ForWriting, replace
ShowFolderList "C:/temp/"
file.Close
MsgBox "done"
End Sub
Sub ShowFolderList(folderspec)
On Error GoTo local_err
Dim f, f1, fc, s, sFldr
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 In fc
If Right(f1, 1) <> "/" Then ShowFolderList f1 & "/" Else ShowFolderList f1
Next
Set fc = f.Files
For Each f1 In fc
file.writeline folderspec & f1.Name
Next
local_exit:
Exit Sub
local_err:
MsgBox Err & " " & Err.Description
Resume local_exit
Resume
End Sub