Rutina para listar ficheros

[javidelri]

Buenos días:

Escribo para ver si alguien puede ayudarme con un pequeño problema que me ha surgido en relación con el listado de unos ficheros en excel, a través del Visual Basic.

Para situaros, debo hacer que a partir de una macro, pueda listar todos los ficheros contenidos de las diferentes carpetas que conforman un directorio. Creía haberlo conseguido, pero me ha surgido un pequeño/gran inconveniente, y es que cuando el programa detecta una carpeta vacía, se detiene y sale. Lo que pretendo conseguir es que genere un nuevo excel donde me liste todos los ficheros, y si la carpeta está vacía, que la salte y continue listando el resto de archivos del rango de direcciones que le doy.

El cuerpo básico del programa que cree es el siguiente:

Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
strFolder = Workbooks(Libro_Origen).Sheets(Hoja_Activa).Range( "A" & Bucle)
' Get a list of all the files in this directory.
' Note that this isn't recursive... although it could be...
varFileList = fcnGetFileList(strFolder)

If Not IsArray(varFileList) Then
MsgBox "No files found.", vbInformation
Exit Sub
End If


' Now let's get all the details for these files and place them into an array so it's quick to dump to XL.
ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)

' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(0, 1) = "Size"
myResults(0, 2) = "Created"
myResults(0, 3) = "Modified"
myResults(0, 4) = "Accessed"
myResults(0, 5) = "Full path"

Set FSO = CreateObject("Scripting.FileSystemObject")

' Loop through our files
For l = 0 To UBound(varFileList)
Set myFile = FSO.GetFile(CStr(strFolder & "\" & varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
myResults(l + 1, 1) = myFile.Size
myResults(l + 1, 2) = myFile.DateCreated
myResults(l + 1, 3) = myFile.DateLastModified
myResults(l + 1, 4) = myFile.DateLastAccessed
myResults(l + 1, 5) = myFile.Path
Next l

' Dump these to a worksheet
Application.ScreenUpdating = True
fcnDumpToWorksheet myResults

El problema creo que está en la definición que hago en rojo. Llevo dandole vueltas unos cuantos días, y no consigo avanzar. Agradezco cualquier tipo de ayuda.

Muchas gracias.

Un saludo.

[javidelri]

Más pistas...

El problema reside en el contador del Ubound... he intentado seguirlo con varios puntos de ruptura, y me surge un error tipo 13, que dice que "no coinciden los tipos"... como intepreto eso????? están mal definidas la variables????

[lokoman]

Hola!
varFileList tiene algun caracer invalido, verificalo

[javidelri]

Iniciado por lokoman

Hola!
varFileList tiene algun caracer invalido, verificalo

Agradezco tu ayuda, lokoman, pero, ¿podrías ser un poco más específico? Esto de la programación no es mi fuerte...

[javidelri]

Continuamos avanzado...

El problema que enontré, una vez analizado paso a paso los distintos valores que tienen las variables es que, cuando la carptea está vacía, al pasar por el IF NOT (en letra roja), por el exit que hay, sale del programa y termina. He probado a cambiar el exit poniéndole EXIT Function, pero no va. Lo que pretendo es que cuando no haya nada, continue el análisis con la función fcnGetFileList y pase a la siguiente carpeta. En lugar del comando EXIT, ¿se puede poner otra instrucción que sirva para saltar una determinada parte de código o algo así?

El varFileList da problema porque al no encontrar nada en la carpeta, toma valor falso, con lo cual el UBuond se vuelve loco y da error...

[lokoman]

Existen los famosos GOTO xxx, pero no se recomiendan su uso, porque "enredan" el code...
Y si lo intentas asi:

Código vb:

Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
 
strFolder = Workbooks(Libro_Origen).Sheets(Hoja_Activa).Range( "A" & Bucle)
varFileList = fcnGetFileList(strFolder)
 
If IsArray(varFileList) Then
 
ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)
 
' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(0, 1) = "Size"
myResults(0, 2) = "Created"
myResults(0, 3) = "Modified"
myResults(0, 4) = "Accessed"
myResults(0, 5) = "Full path"
 
Set FSO = CreateObject("Scripting.FileSystemObject")
 
' Loop through our files
For l = 0 To UBound(varFileList)
Set myFile = FSO.GetFile(CStr(strFolder & "\" & varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
myResults(l + 1, 1) = myFile.Size
myResults(l + 1, 2) = myFile.DateCreated
myResults(l + 1, 3) = myFile.DateLastModified
myResults(l + 1, 4) = myFile.DateLastAccessed
myResults(l + 1, 5) = myFile.Path
Next l
 
' Dump these to a worksheet
Application.ScreenUpdating = True
fcnDumpToWorksheet myResults
 
END IF
 

[javidelri]

Nop!!!!! Seguimos off!!! Sorry, pero gracias, de todos modos!!!!

[lokoman]

Si el proceso es:

1-Lees de un archivo excel una ruta
2-Cargas los archivos de esta ruta en un array
3-Si no hay archivos, debes leer otra ruta del archivo excel

Debes tener un bucle para leer de 1 en 1 las rutas que tiene el archivo excel, es decir, como tienes:

Código vb:

strFolder = Workbooks(Libro_Origen).Sheets(Hoja_Activa).Range( "A" & Bucle)
 

La variable "BUCLE" del CODE: .Range( "A" & Bucle), quiere decir que lees de la celda A1, despues la A2, despues la A3, y asi sucesivamente. La variable "BUCLE" la debes alimentar asi: BUCLE=BUCLE + 1 dentro de un FOR o un DO fuera de la rutina o funcion:

Código vb:

PRIVATE SUB COMMAND_CLICK()
   BUCLE=1
 
   FOR I=1 TO 1000
      LLAMADA_SUBRUTINA (BUCLE)
      BUCLE=BUCLE + 1
   NEXT I
END SUB
 
SUB LLAMADA_SUBRUTINA (BUCLE AS DOUBLE)
   Dim strFolder As String
   Dim varFileList As Variant,  myResults As Variant
   Dim FSO As Object, myFile As Object
   Dim l As Long
 
   strFolder = Workbooks(Libro_Origen).Sheets(Hoja_Activa).Range( "A" & Bucle)
   varFileList = fcnGetFileList(strFolder)
 
   IF IsArray(varFileList) THEN
'      ...
'      ...
'      ...
      Application.ScreenUpdating = True
      fcnDumpToWorksheet myResults
   END IF
 
END SUB
 

Intenta a ver...