Directorios y Excel

Hola por favor quisiera saber si conoces el código de este ejemplo que hay en esta dirección http://www.webandmacros.com/macro_excel_listar_archivos.htm
Por favor me interesa poder aplicar y modificar a mis necesidades esta macro si fuera posible y si tienes este código me lo podrías dar, gracias o si saber como puedo llegar a tener estos resultados de otra formo con macros

1 Respuesta

Respuesta
1
El archivo se encuentra protegido con contraseña. Aunque no me es difícil desbloquearlo, no se que consecuencias me repercutirían con el autor.
Mejor aquí tienes una macro para que puedas listar archivos. Inserta un botón o Autoforma y le asignas la macro ListFiles. Espero te sirva.
Option Explicit
'declaraciones 32-bit API
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 ListFiles()
Dim Msg As String
Dim Directory As String, f As String
Dim r As Long
Msg = "Seleccionar una localización que contenga los archivos que quiera poner en lista."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
r = 1
' Insertar encabezados
Cells.ClearContents
Cells(r, 1) = "NombreArchivo"
Cells(r, 2) = "Tamaño"
Cells(r, 3) = "Fecha/Hora"
Range("A1:C1").Font.Bold = True
' Obtener el primer achivo
f = Dir(Directory, 7)
Do While f <> ""
r = r + 1
Cells(r, 1) = f
Cells(r, 2) = FileLen(Directory & f)
Cells(r, 3) = FileDateTime(Directory & f)
' Obtener el archivo siguiente
f = Dir
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
' Fichero Matriz = Escritorio
bInfo.pidlRoot = 0&
' Título en el diálogo
If IsMissing(Msg) Then
bInfo.lpszTitle = "Seleccionar una carpeta."
Else
bInfo.lpszTitle = Msg
End If
' Escriba el directorio para volver
bInfo.ulFlags = &H1
' Mostrar el diálogo
x = SHBrowseForFolder(bInfo)
' Analice 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
Hola y gracias por el código funciona de maravilla pero no entendí muy bien el código porque aun no soy muy experto en el tema de las macros, apenas estoy en el proceso de aprendizaje.
Experto por favor me podría ayudar quiero que ese proceso me lo haga llamando los archivos desde este directorio C:\Facturas Lorca\Facturas Lorca
Si te fijas bien, tú puedes escoger por medio del cuadro que sale, de cuál directorio deseas importar los datos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas