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
1
Anónimo
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