[VBA] Récupérer l'arborescence complète d'un dossier serveur
Récupérer l'arborescence complète d'un dossier serveur [VBA] - VB/VBA/VBS - Programmation
Marsh Posté le 02-07-2018 à 21:47:14
Bonjour,
Un vieil exemple :
https://mon-partage.fr/f/LVBak4Gd/
---------------
Cordialement, Patrice
Marsh Posté le 07-07-2018 à 01:28:23
Salut, avec un peu de retard, mais si tu es curieux voir ici :
https://excel.developpez.com/telech [...] 32-64-Bits
https://excel.developpez.com/telech [...] plus-Liens
https://excel.developpez.com/telech [...] borescence
https://excel.developpez.com/telech [...] un-dossier
Message édité par kiki29 le 07-07-2018 à 01:30:51
---------------
Myanmar 90/91 : http://gadaud.gerard.free.fr/publi [...] index.html
Sujets relatifs:
- VBA - Prendre en compte les retours de formule
- Aide VBA userforme
- [VBA] Erreur 4605 lors d'un Publipostage.
- [PHP / JS] Récupérer ligne txt
- Pb VBA dans l'utilisation du FullSeriesCollection(1).XValues
- Synchronisation de dossier
- Partage de dossier sur Windows 7 Embedded
- Récupérer le contenu d'un input text
- Déplacer des fichiers -> dossier avec une partie du nom des fichiers
- Editer une fonction en VBA.
Marsh Posté le 02-07-2018 à 16:22:59
Je dois récupérer la liste de l'intégralité des fichiers présents sur une partie d'un serveur, j'utilise un truc trouvé sur le net qui semble fonctionner, sauf qu'il me semble y avoir beaucoup trop de fichiers à gérer.
J'ai essayé de découper avec une For les dossiers principaux, mais même problème (Erreur 1004)
Est-ce que je dois encore découper au niveau inférieur, sachant que je sais pas trop jusqu'à quelle "profondeur" jpeux me retrouver à devoir chercher les chemins à la main, ou y aurai une solution.
J'utilise VBA parce que c'est principalement ce que je sais utiliser, mais si y a une alternative pas trop compliqué à mettre en place je suis preneur aussi.
Merci.
Option Explicit
Sub TestListeFichiers()
Dim Dossier As String
Dim x As Long
'Définit le répertoire pour débuter la recherche de fichiers.
'(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
'fichiers, sinon le temps de traitement va être très long).
For x = 1 To 54
Dossier = Worksheets(2).Range("A" & x).Value
'Appelle la procédure de recherche des fichiers
ListeFichiers Dossier
Next
'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
Columns("A:E" ).AutoFit
MsgBox "Terminé"
End Sub
Sub ListeFichiers(Repertoire As String)
'
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Set Fso = CreateObject("Scripting.FileSystemObject" )
Set SourceFolder = Fso.GetFolder(Repertoire)
'Récupère le numéro de la dernière ligne vide dans la colonne A.
i = Range("A65536" ).End(xlUp).Row + 1
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
'Inscrit le nom du fichier dans la cellule
Cells(i, 1) = FileItem.Name
'Ajoute un lien hypertexte vers le fichier
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
Address:=FileItem.ParentFolder & "\" & FileItem.Name
'Indique la date de création
Cells(i, 2) = FileItem.DateCreated
'Indique la date de dernier acces
Cells(i, 3) = FileItem.DateLastAccessed
'Indique la date de dernière modification
Cells(i, 4) = FileItem.DateLastModified
'Nom du répertoire
Cells(i, 5) = FileItem.ParentFolder
i = i + 1
Next FileItem
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.SubFolders
ListeFichiers SubFolder.Path
Next SubFolder
End Sub