Listado de archivos de una carpeta (modificar el código expuesto)

08/08/2006 - 21:39 por ~ jose ~ | Informe spam

Hola,
tengo este código (sacado en este foro) para extraer los nombres de
los archivos alojados en una carpeta pero quiero que la ruta del
directorio sea la que escribo en la celda B1 de la 'Hoja1' y los
archivos que quiero ver sean las extensiones que ponga en la celda B2,
por ejemplo los *.jpg
¿Y si quiero mas de una extensión lo tendria que poner en la celda B3
o con poner *.jpg, *.gif, etc... seria suficiente?
Este es el código

Sub DIR_EnHojaDeCálculo()
Dim fso As New FileSystemObject
Dim fsFolder As Folder
Dim fsFile As File
Dim wksH As Worksheet
Dim lngContLínea As Long
lngContLínea = 2

Set fsFolder = fso.GetFolder("C:\Excel") 'Directorio que se
mostrará.
Set wksH = Worksheets("Hoja2") 'Hoja en que se volcarán los datos

On Error GoTo ManejoErrores

With wksH

'Poner algunos títulos en la hoja de cálculo
.Range("A1") = "Nombre corto"
.Range("B1") = "Tamaño"
.Range("C1") = "Fecha Modif."
.Range("D1") = "Nombre largo"

For Each fsFile In fsFolder.Files

.Cells(lngContLínea, 1) = fsFile.ShortName
.Cells(lngContLínea, 2) = fsFile.Size
.Cells(lngContLínea, 3) = fsFile.DateLastModified
.Cells(lngContLínea, 4) = fsFile.Name

lngContLínea = lngContLínea + 1

Next fsFile

.Cells(lngContLínea, 2).FormulaLocal = "=SUMA(B2:B" &
Trim(Str(lngContLínea) - 1) & ")"
.Range("B2:B" & Trim(Str(lngContLínea))).NumberFormat "#,##0"
.Columns("A:D").AutoFit

End With

Set wksH = Nothing
Set fsFile = Nothing
Set fsFolder = Nothing
Set fso = Nothing

Exit Sub

ManejoErrores:
'En Windows XP, algunos ficheros del sistema (como el de
paginación) carecen de nombre corto, por lo que hay que capturar el
error que se produce al intentar acceder a él (propiedad ShortName).
If Err.Number = 5 Then
Resume Next
Else
MsgBox prompt:="Error " & Err.Number & " " & Err.Description,
Buttons:=vbOKOnly + vbCritical
Exit Sub
End If
End Sub

Siga el debate

2 respuestas

Tengo una respuesta

Preguntas similare

Listado de archivos de una carpeta (modificar el código expuesto)

Leer las respuestas

#1 Héctor Miguel

09/08/2006 - 07:11 | Informe spam

hola, jose !

tengo este codigo (sacado en este foro) para extraer los nombres de los archivos alojados en una carpeta
pero quiero que la ruta del directorio sea la que escribo en la celda B1 de la 'Hoja1'
y los archivos que quiero ver sean las extensiones que ponga en la celda B2, por ejemplo los *.jpg
Y si quiero mas de una extension lo tendria que poner en la celda B3 o con poner *.jpg, *.gif, etc... seria suficiente? [...]

el siguiente ejemplo [que puedes adaptar para otras necesidades]...
1) 'toma' la carpeta predeterminada que pongas en 'A1' [p.e. -> c:uta y\sub-carpeta\]
nota: puedes omitir el separador de rutas final -> \
2) 'toma' los criterios [EXTensiones] que pongas en algun rango [p.e. 'A2:B2'] del tipo: *.doc y/o *.xls
nota: el asterisco es necesario... es UNO por celda, y... si NO pones ninguno... no devuelve nada !!!
3) pone en el rango 'A3:G3' los titulos de 'algunos' atributos de los archivos en 'esa' carpeta
4) a partir de la fila 4, vacia los nombres [y sus atributos] que se encuentran en la carpeta 'solicitada' ;)

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

en un modulo de codigo 'general' ==Sub ListarArchivosEnCarpeta()
Application.ScreenUpdating = False
Dim Carpeta As String, Fila As Long, Archivo, RutaCorta As String, Criterios As String, Tmp As Range
Carpeta = Range("a1"): Range("a1,e1").ClearContents
Fila = 4
Criterios = "a2:b2" ' si necesitas mas 'criterios'... amplia las columnas de este rango :)) '
Set Tmp = Cells.Find(Empty)
Range("a3:g3") = Array( _
"Nombre", "Tamaño", "Tipo", "Creado", "Acceso", "Modificado", "Nombre corto")
With CreateObject("Scripting.FileSystemObject")
With .GetFolder(Carpeta): RutaCorta = .ShortPath
For Each Archivo In .Files
With Archivo: Tmp = .Name
If Application.SumProduct(Application.CountIf(Tmp, Range(Criterios))) Then
Range("a" & Fila & ":g" & Fila) = Array( _
.Name, .Size, .Type, .DateCreated, .DateLastAccessed, .DateLastModified, .ShortName)
Fila = Fila + 1
End If
End With
Next
End With
End With
Tmp.ClearContents: Set Tmp = Nothing
Range("a1:g1").EntireColumn.AutoFit: Range("a1") = Carpeta: Range("e1") = RutaCorta
End Sub

Responder a este mensaje

#2 ~ jose ~

09/08/2006 - 18:33 | Informe spam

Hola Héctor,
muy bien, ahora ya lo modificaré a mi gusto,
gracias.

Héctor Miguel wrote:

hola, jose !

> tengo este codigo (sacado en este foro) para extraer los nombres de los archivos alojados en una carpeta
> pero quiero que la ruta del directorio sea la que escribo en la celda B1 de la 'Hoja1'
> y los archivos que quiero ver sean las extensiones que ponga en la celda B2, por ejemplo los *.jpg
> Y si quiero mas de una extension lo tendria que poner en la celda B3 o con poner *.jpg, *.gif, etc... seria suficiente? [...]

el siguiente ejemplo [que puedes adaptar para otras necesidades]...
1) 'toma' la carpeta predeterminada que pongas en 'A1' [p.e. -> c:uta y\sub-carpeta\]
nota: puedes omitir el separador de rutas final -> \
2) 'toma' los criterios [EXTensiones] que pongas en algun rango [p.e. 'A2:B2'] del tipo: *.doc y/o *.xls
nota: el asterisco es necesario... es UNO por celda, y... si NO pones ninguno... no devuelve nada !!!
3) pone en el rango 'A3:G3' los titulos de 'algunos' atributos de los archivos en 'esa' carpeta
4) a partir de la fila 4, vacia los nombres [y sus atributos] que se encuentran en la carpeta 'solicitada' ;)

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

en un modulo de codigo 'general' ==> Sub ListarArchivosEnCarpeta()
Application.ScreenUpdating = False
Dim Carpeta As String, Fila As Long, Archivo, RutaCorta As String, Criterios As String, Tmp As Range
Carpeta = Range("a1"): Range("a1,e1").ClearContents
Fila = 4
Criterios = "a2:b2" ' si necesitas mas 'criterios'... amplia las columnas de este rango :)) '
Set Tmp = Cells.Find(Empty)
Range("a3:g3") = Array( _
"Nombre", "Tamaño", "Tipo", "Creado", "Acceso", "Modificado", "Nombre corto")
With CreateObject("Scripting.FileSystemObject")
With .GetFolder(Carpeta): RutaCorta = .ShortPath
For Each Archivo In .Files
With Archivo: Tmp = .Name
If Application.SumProduct(Application.CountIf(Tmp, Range(Criterios))) Then
Range("a" & Fila & ":g" & Fila) = Array( _
.Name, .Size, .Type, .DateCreated, .DateLastAccessed, .DateLastModified, .ShortName)
Fila = Fila + 1
End If
End With
Next
End With
End With
Tmp.ClearContents: Set Tmp = Nothing
Range("a1:g1").EntireColumn.AutoFit: Range("a1") = Carpeta: Range("e1") = RutaCorta
End Sub

Siga el debate Respuesta

Responder a este mensaje

Ads by Google

Hacer una pregunta

Tengo una respuesta

Busqueda sugerida