18/01/2008, 06:17
|
| | | Fecha de Ingreso: agosto-2007
Mensajes: 1.338
Antigüedad: 17 años, 4 meses Puntos: 18 | |
Re: Trasladar estructura de carpetas a Excel y esta para carpetas y sub carpetas:
Public Function ListarArchivosCarpetaYSubCarpetas(nomCarpeta As String, NumFila)
Dim ObjetoFSO As Object
Dim Carpeta As Object
Dim SubCarpeta As Object
Dim Archivos As Object
Dim Archivo As Object
Dim fila As Integer
Dim Columna As Integer
Columna = 1
fila = NumFila
Set ObjetoFSO = CreateObject("Scripting.FileSystemObject")
Set Carpeta = ObjetoFSO.GetFolder(nomCarpeta)
Set Archivos = Carpeta.Files
For Each Archivo In Archivos
'Buscamos en los archivos de la carpeta
'Buscamos en los archivos de la carpeta
fila = fila + 1
ActiveSheet.Cells(fila, Columna).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=nomCarpeta & "\" & Archivo.Name, _
TextToDisplay:=Archivo.Name
Next
Set Archivos = Nothing
' Buscamos en las carpetas y subcarpeta haciendo
'llamadas recursivas a la funcion
For Each SubCarpeta In Carpeta.SubFolders
Call ListarArchivosCarpetaYSubCarpetas(nomCarpeta & "\" & SubCarpeta.Name, fila)
Next
Set Carpeta = Nothing
Set ObjetoFSO = Nothing
End Function
Y la llamas asi:
Call ListarArchivosCarpetaYSubCarpetas("C:\demo", 0)
Un saludo |