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
 

Preguntas similares