Excel. Lista de archivos en mi FTP

Buenos días

Con FSO y Shell:

Option Explicit Option Private Module ' ' Nota: hay que activar las referencias (en Herramientas > Referencias ...) a: ' - Microsoft Scripting Runtime ' - Microsoft Shell Controls And Automation ' Public Sub Lister_Fichiers() ' Lista los archivos de un directorio y de sus subdirectorios en una hoja de Excel ' La información almacenada es: ' - nombre del archivo, ' - ruta completa, ' - directorio, ' - fecha de creación, ' - fecha de último acceso, ' - fecha de última modificación, ' - tamaño, ' - atributos. ' ' Date Developpeur Action ' ------------------------------------------------------------------------------------------- ' 14/06/10 Patrice Versión 1.0.2 ' Dim objShell As Shell32.Shell 'Shell Dim objChoix As Shell32.Folder 'Selección de búsqueda carpeta Dim wbkRapport As Excel.Workbook 'Libro de trabajo de informe ' Dim rngPlage As Excel.Range 'Rango genérico Dim strChemin As String 'Ruta de la carpeta Dim strMsg As String 'Mensaje de la caja de diálogo Const WINDOW_HANDLE = 0 Const OPTIONS = 513 'salvo carpetas del sistema y sin el botón Nueva carpeta On Error Resume Next 'Mostrar la caja de diálogo con la estructura de árbol strMsg = "Selecciona el directorio a analizar:" Set objShell = New Shell32.Shell Set objChoix = objShell.BrowseForFolder(WINDOW_HANDLE, strMsg, OPTIONS) strChemin = objChoix.Items.Item.Path 'strChemin = objChoix.Self.Path 'Si la ruta es válida If strChemin <> "" Then Application.Interactive = False '- detener la actualización de pantalla y los cálculos Application.Cursor = xlWait Application.Calculation = xlCalculationManual Application.ScreenUpdating = False '- añadir un nuevo libro Set wbkRapport = Application.Workbooks.Add(xlWBATWorksheet) Set rngPlage = wbkRapport.Worksheets(1).Range(Cells(1, 1), Cells(1, 10)) '- escribir los encabezados de columna With rngPlage .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Cells(1, 1).Formula = "Fichier concerné" .Cells(1, 2).Formula = "Date de création" .Cells(1, 3).Formula = "Date dernier accès" .Cells(1, 4).Formula = "Date de dernière modification" .Cells(1, 5).Formula = "Taille du fichier en ko" .Cells(1, 6).Formula = "Type du fichier" .Cells(1, 7).Formula = "Extension" .Cells(1, 8).Formula = "Attributs" .Cells(1, 9).Formula = "Chemin d'accès au fichier" .Cells(1, 10).Formula = "Chemin complet du fichier" .Columns.AutoFit End With '- lister l'arborescence du dossier Call ListerDossier(strChemin, wbkRapport) '- rétablir l'actualisation de pantalla y los cálculos Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.Cursor = xlDefault Application.Interactive = True End If Set objShell = Nothing Set objChoix = Nothing End Sub Private Sub ListerDossier(strChemin As String, wbkRapport As Excel.Workbook) ' Procedimiento recursivo que lista la arborescencia del directorio (y de sus subdirectorios) ' ' Argumentos : strChemin [in] Ruta del directorio a explorar ' wbkRapport [in] Archivo de informe ' ' Date Developpeur Action ' ------------------------------------------------------------------------------------------- ' 14/06/10 Patrice Versión 1.0.2 ' Dim objFSO As FileSystemObject ' Objeto del sistema de archivos Dim objRep As Scripting.File ' Carpeta a analizar Dim objSubRep As Scripting.Folders ' Colección de subcarpetas Dim objSubRepItem As Scripting.Folder ' Subcarpeta Dim objSubFile As Scripting.Files ' Colección de archivos de la carpeta Dim objSubFileItem As Scripting.File ' Archivo buscado Dim rngPlage As Excel.Range 'Rango genérico Dim strAtt As String 'Atributos del archivo Dim n°L As Integer 'Nº de la línea a escribir en la hoja de cálculo Dim att As Integer 'Valor de los atributos del archivo Dim adr As String Dim ctr As Integer On Error Resume Next 'Explorar la carpeta Set objFSO = New FileSystemObject Set objRep = objFSO.GetFolder(strChemin) 'carpeta Set objSubRep = objRep.SubFolders 'sous-carpetas '- procesar cada subcarpeta For Each objSubRepItem In objSubRep Call ListerDossier(objSubRepItem.Path, wbkRapport) 'llamada recursiva Next Set objSubFile = objRep.Files 'archivos '- procesar cada archivo For Each objSubFileItem In objSubFile '-- asignación del nombre de los atributos att = objSubFileItem.Attributes strAtt = "" If att = 0 Then strAtt = "Ninguno" If att And 8 Then strAtt = strAtt & "V " 'Volumen If att And 16 Then strAtt = strAtt & "D " 'Directorio If att And 1 Then strAtt = strAtt & "R" 'Solo lectura If att And 2 Then strAtt = strAtt & "H" 'Oculto If att And 4 Then strAtt = strAtt & "S" 'Sistema If att And 32 Then strAtt = strAtt & "A" 'Archivo If att And 1024 Then strAtt = strAtt & " Alias" If att And 2048 Then strAtt = strAtt & " Compressed" '-- escritura de la línea en la hoja de cálculo Set rngPlage = wbkRapport.Worksheets(1).Range(Cells(1, 1), Cells(1, 10)) Set rngPlage = rngPlage.Offset(wbkRapport.Worksheets(1).UsedRange.Rows.Count) With rngPlage adr = .Address .Cells(1, 1).Formula = objSubFileItem.Name .Cells(1, 2).Formula = objSubFileItem.DateCreated .Cells(1, 3).Formula = objSubFileItem.DateLastAccessed .Cells(1, 4).Formula = objSubFileItem.DateLastModified .Cells(1, 5).Formula = Arrondi(objSubFileItem.Size / 1024, 0) .Cells(1, 5).HorizontalAlignment = xlCenter .Cells(1, 6).Formula = objSubFileItem.Type .Cells(1, 7).Formula = objFSO.GetExtensionName(objSubFileItem.Name) .Cells(1, 7).HorizontalAlignment = xlCenter .Cells(1, 8).Formula = strAtt .Cells(1, 8).HorizontalAlignment = xlCenter .Cells(1, 9).Formula = objSubFileItem.ParentFolder .Cells(1, 10).Formula = objSubFileItem.Path ' .Offset(1 - .Row).Resize(.Row).Columns.AutoFit End With Next If Not rngPlage Is Nothing Then rngPlage.Offset(1 - rngPlage.Row).Resize(rngPlage.Row).Columns.AutoFit Set rngPlage = Nothing End If Set objFSO = Nothing Set objRep = Nothing Set objSubRep = Nothing Set objSubRepItem = Nothing Set objSubFile = Nothing Set objSubFileItem = Nothing End Sub Private Function Arrondi(ByVal Nombre, ByVal Decimales) ' Reemplaza la función VBA Round() que funciona mal para los ' números de la forma 2a + 0,5 (redondea hacia abajo !!!) ' ' Argumentos : Nombre [in] Número a redondear ' Decimales [in] Número de decimales ' ' Date Developpeur Action ' ------------------------------------------------------------------------------------------- ' 28/08/06 Patrice Versión 2.0 ' Arrondi = Int(Nombre * 10 ^ Decimales + 1 / 2) / 10 ^ Decimales End Function

Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour cela qu'on le partage.

Hola Patrice,

Estoy creando archivos que son utilizados por muchos puestos de trabajo.
Los usuarios acceden mediante un archivo de apertura en línea.
Este archivo de apertura descarga en sus máquinas los archivos comunes.
Actualmente no es muy bueno porque en cada apertura descargan todos los archivos.
Quiero que descarguen solo los archivos modificados.
Había hecho una macro, pero tampoco muy bien, ya que cargaba todos los archivos para comparar las fechas y solo guardaba los modificados; era lento e poco fiable.
Por eso, esta lista permitirá comparar y descargar solo los archivos necesarios.
El problema es que no puedo intervenir en las distintas máquinas para activar herramientas o referencias de Microsoft, además de que algunos están en 7 y otros en 8.

¿Soy lo suficientemente claro? En cualquier caso, infinitas gracias, me las ingenio un poco con Excel, pero no entiendo nada de las conexiones externas (importante: todos los usuarios usan Excel 2016).

Eres muy simpático, pero con 70 años seguramente no soy capaz de entender lol
no encuentro dónde ingresar el nombre de mi .com y el directorio para listar?
¿hay que ingresar el pass en algún lugar?
busco pero no encuentro