Excel. Liste des fichiers sur mon Ftp
Fermé
johnpeterviper
Messages postés
9
Date d'inscription
lundi 9 septembre 2019
Statut
Membre
Dernière intervention
12 septembre 2019
-
12 sept. 2019 à 07:44
johnpeterviper Messages postés 9 Date d'inscription lundi 9 septembre 2019 Statut Membre Dernière intervention 12 septembre 2019 - 12 sept. 2019 à 11:55
johnpeterviper Messages postés 9 Date d'inscription lundi 9 septembre 2019 Statut Membre Dernière intervention 12 septembre 2019 - 12 sept. 2019 à 11:55
A voir également:
- Excel. Liste des fichiers sur mon Ftp
- Liste déroulante excel - Guide
- Formule excel - Guide
- Excel liste déroulante en cascade - Guide
- Fusionner des fichiers excel - Guide
- Si et excel - Guide
3 réponses
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 775
Modifié le 12 sept. 2019 à 08:56
Modifié le 12 sept. 2019 à 08:56
Bonjour
Avec le FSO et Shell :
Avec le FSO et Shell :
Option Explicit Option Private Module ' ' Note : il faut activer les références (dans Outils > Références ...) à : ' - Microsoft Scripting Runtime ' - Microsoft Shell Controls And Automation ' Public Sub Lister_Fichiers() ' Liste les fichiers d'un répertoire et de ses sous-répertoires dans une feuille Excel ' Les informations stockées sont : ' - nom du fichier, ' - chemin complet, ' - répertoire, ' - date de création, ' - date de dernier accés, ' - date de dernière modification, ' - taille, ' - attribut. ' ' Date Developpeur Action ' ------------------------------------------------------------------------------------------- ' 14/06/10 Patrice Version 1.0.2 ' Dim objShell As Shell32.Shell 'Shell Dim objChoix As Shell32.Folder 'Choix de recherche dossier Dim wbkRapport As Excel.Workbook 'Classeur résultat Dim rngPlage As Excel.Range 'Plage générique Dim strChemin As String 'Chemin du dossier Dim strMsg As String 'Message de la boite de dialogue Const WINDOW_HANDLE = 0 Const OPTIONS = 513 'sauf dossiers système et sans le bouton Nouveau dossier On Error Resume Next 'Afficher la boite de dialogue avec l'arborescence strMsg = "Choisir le répertoire à analyser :" Set objShell = New Shell32.Shell Set objChoix = objShell.BrowseForFolder(WINDOW_HANDLE, strMsg, OPTIONS) strChemin = objChoix.Items.Item.Path 'strChemin = objChoix.Self.Path 'Si le chemin est valide If strChemin <> "" Then Application.Interactive = False '- arrêter l'actualisation écran et les calculs Application.Cursor = xlWait Application.Calculation = xlCalculationManual Application.ScreenUpdating = False '- ajouter un nouveau classeur Set wbkRapport = Application.Workbooks.Add(xlWBATWorksheet) Set rngPlage = wbkRapport.Worksheets(1).Range(Cells(1, 1), Cells(1, 10)) '- écrire les en-têtes de colonne 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 écran et les calculs 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) ' Procédure récursive qui liste l'arborescence du dossier (et des sous-dossiers) ' ' Arguments : strChemin [in] Chemin du dossier à explorer ' wbkRapport [in] Fichier rapport ' ' Date Developpeur Action ' ------------------------------------------------------------------------------------------- ' 14/06/10 Patrice Version 1.0.2 ' Dim objFSO As FileSystemObject 'File System Object Dim objRep As Scripting.Folder 'Dossier à analyser Dim objSubRep As Scripting.Folders 'Collection de Sous-dossiers Dim objSubRepItem As Scripting.Folder 'Sous-dossier Dim objSubFile As Scripting.Files 'Collection des fichiers du dossier Dim objSubFileItem As Scripting.File 'Fichier cherché Dim rngPlage As Excel.Range 'Plage générique Dim strAtt As String 'Attributs du fichier Dim n°L As Integer 'N° de la ligne à écrire sur la feuille de calcul Dim att As Integer 'Valeur des attributs du fichier Dim adr As String Dim ctr As Integer On Error Resume Next 'Explorer le dossier Set objFSO = New FileSystemObject Set objRep = objFSO.GetFolder(strChemin) 'dossier Set objSubRep = objRep.SubFolders 'sous-dossiers '- traiter chaque sous-dossier For Each objSubRepItem In objSubRep Call ListerDossier(objSubRepItem.Path, wbkRapport) 'appel recursif Next Set objSubFile = objRep.Files 'fichiers '- traiter chaque fichier For Each objSubFileItem In objSubFile '-- affectation du nom des attributs att = objSubFileItem.Attributes strAtt = "" If att = 0 Then strAtt = "Aucun" If att And 8 Then strAtt = strAtt & "V " 'Volume If att And 16 Then strAtt = strAtt & "D " 'Directory If att And 1 Then strAtt = strAtt & "R" 'Read Only If att And 2 Then strAtt = strAtt & "H" 'Hidden If att And 4 Then strAtt = strAtt & "S" 'System If att And 32 Then strAtt = strAtt & "A" 'Archive If att And 1024 Then strAtt = strAtt & " Alias" If att And 2048 Then strAtt = strAtt & " Compressed" '-- écriture de la ligne sur la feuille de calcul 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) ' Remplace la fonction VBA Round() qui fonctionne mal pour les ' nombres de la forme 2a + 0,5 (arrondis à l'inférieur !!!) ' ' Arguments : Nombre [in] Nombre à arrondir ' Décimales [in] Nombre de décimales ' ' Date Developpeur Action ' ------------------------------------------------------------------------------------------- ' 28/08/06 Patrice Version 2.0 ' Arrondi = Int(Nombre * 10 ^ Decimales + 1 / 2) / 10 ^ Decimales End Function
johnpeterviper
Messages postés
9
Date d'inscription
lundi 9 septembre 2019
Statut
Membre
Dernière intervention
12 septembre 2019
12 sept. 2019 à 09:27
12 sept. 2019 à 09:27
Bonjour Patrice,
Je réalise des fichiers qui sont utilisés par de nombreux postes de travail
Les utilisateurs accèdent par un fichier d'ouverture en ligne
Ce fichier d'ouverture télécharge sur leurs machines les fichiers communs
Actuellement c'est pas super car a chaque ouverture ils téléchargent tous les fichiers
Je souhaite qu'ils ne téléchargent que les fichiers modifiés
J'avais fait une macro pas terrible non plus puisqu'elle chargeait tous les fichiers pour comparer les dates et enregistrait que ceux modifiés, c'était long et pas fiable.
Donc cette liste permettra de comparer et de télécharger que les fichiers nécessaires
Le soucis c'est que je ne peux pas intervenir sur les différentes machines pour activer des outils ou des références Microsoft, d'autant que certains sont sur 7 et d'autres sur 8
Suis je assez clair ? Dans tous les cas infiniment MERCI, je me débrouille un peu avec excel mais je ne comprends rien aux liaisons externes (important : tous les utilisateurs utilisent excel 2016)
Je réalise des fichiers qui sont utilisés par de nombreux postes de travail
Les utilisateurs accèdent par un fichier d'ouverture en ligne
Ce fichier d'ouverture télécharge sur leurs machines les fichiers communs
Actuellement c'est pas super car a chaque ouverture ils téléchargent tous les fichiers
Je souhaite qu'ils ne téléchargent que les fichiers modifiés
J'avais fait une macro pas terrible non plus puisqu'elle chargeait tous les fichiers pour comparer les dates et enregistrait que ceux modifiés, c'était long et pas fiable.
Donc cette liste permettra de comparer et de télécharger que les fichiers nécessaires
Le soucis c'est que je ne peux pas intervenir sur les différentes machines pour activer des outils ou des références Microsoft, d'autant que certains sont sur 7 et d'autres sur 8
Suis je assez clair ? Dans tous les cas infiniment MERCI, je me débrouille un peu avec excel mais je ne comprends rien aux liaisons externes (important : tous les utilisateurs utilisent excel 2016)
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 775
12 sept. 2019 à 10:10
12 sept. 2019 à 10:10
Re,
Tu peux te passer des références (EarlyBinding) en utilisant le LateBinding
Par exemple, au lieu de :
On écrit :
Tu peux te passer des références (EarlyBinding) en utilisant le LateBinding
Par exemple, au lieu de :
Dim objShell As Shell32.Shell '... Set objShell = New Shell32.Shell '... Dim objFSO As FileSystemObject '... Set objFSO = New FileSystemObject
On écrit :
Dim objShell As Object '... Set objShell = CreateObject("Shell.Application") '... Dim objFSO As Object '... Set objFSO = CreateObject("Scripting.fileSystemObject")
johnpeterviper
Messages postés
9
Date d'inscription
lundi 9 septembre 2019
Statut
Membre
Dernière intervention
12 septembre 2019
12 sept. 2019 à 11:55
12 sept. 2019 à 11:55
Tu es super sympa, mais à 70 ans je suis surement inapte à comprendre lol
je ne trouve pas ou entrer le nom de mon .com et le répertoire à lister ?
faut il entrer qq part le pass ?
j'ai beau chercher je ne trouve pas
je ne trouve pas ou entrer le nom de mon .com et le répertoire à lister ?
faut il entrer qq part le pass ?
j'ai beau chercher je ne trouve pas