Recuperar nombres de archivos de una carpeta

Buenos días,
¿Cómo puedo recuperar el nombre. Extensión de los archivos que se encuentran en una carpeta? Y ¿Cómo puedo colocar los mismos verticalmente en una columna en excel?
Gracias por sus respuestas.
Saludos,
Alfredo.

1 Respuesta

Respuesta
1
Para lo que estas necesitando tengo una macro que utilizo. Lo que tienes que hacer es crear un nuevo módulo desde visual basic y pegar el código que voy a colocar más abajo, luego desde excel llamas la macro "ListarArchivos" y listo. Una cosa importante es que dentro del código hay una instrucción "Cells.ClearContents" que elimina todo el contenido de la hoja, por lo que no vaya a ejecutar la macro en una hoja con otra información:
'Declaraciones API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub ListarArchivos()
Dim Extension$
Msg = "Seleccione la ubicación que contiene los archivos que usted desea listar."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
r = 1
' Inserta los encabezados
Cells.ClearContents
Cells(r, 1) = "Nombre Archivo"
Cells(r, 2) = "Tamaño"
Cells(r, 3) = "Fecha/Hora"
Cells(r, 4) = "Directorio"
Range("A1:D1").Font.Bold = True
r = r + 1
' Obtiene el primer archivo
f = Dir(Directory, 7)
Cells(r, 1) = f
Cells(r, 2) = FileLen(Directory & f)
Cells(r, 2).NumberFormat = "0 ""Kb"""
Cells(r, 3) = FileDateTime(Directory & f)
Cells(r, 4) = Directory
' Obtiene los archivos restantes
Do While f <> ""
f = Dir
If f <> "" Then
r = r + 1
Cells(r, 1) = f
Cells(r, 2) = FileLen(Directory & f)
Cells(r, 2).NumberFormat = "0 ""Kb"""
Cells(r, 3) = FileDateTime(Directory & f)
Cells(r, 4) = Directory
End If
Loop
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Carpeta raiz = Escritorio
bInfo.pidlRoot = 0&
' Título del cuadro de mensaje
If IsMissing(Msg) Then
bInfo.lpszTitle = "Seleccione una carpeta"
Else
bInfo.lpszTitle = Msg
End If
' Tipo de directorio que será devuelto
bInfo.ulFlags = &H1
' Mostrar el cuadro de diálogo
x = SHBrowseForFolder(bInfo)
' Analizar el resultado
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas