VBA Excel - Lister fichiers & caractéristique
Fermé
Finndelle
Messages postés
1
Date d'inscription
vendredi 8 août 2008
Statut
Membre
Dernière intervention
8 août 2008
-
8 août 2008 à 17:39
liryc - 15 févr. 2010 à 16:23
liryc - 15 févr. 2010 à 16:23
A voir également:
- Vba excel lister les dossiers d'un répertoire
- Liste déroulante excel - Guide
- Formule excel - Guide
- Mettre un mot de passe sur un dossier - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
2 réponses
Bonjour,
Sice n'est pas trop tard ou si le sujet vous intéresse toujours, je suis prête à vous aider car je suis en retraite et j'ai fait beaucoup de VBA
Cordialement
Sice n'est pas trop tard ou si le sujet vous intéresse toujours, je suis prête à vous aider car je suis en retraite et j'ai fait beaucoup de VBA
Cordialement
Bonjour,
Je dessinateur industriel sur Solid Egde et j'aurais besoins de lister les plans que j'ai créé (fichier.dft).
Je suis plus que novice dans le domaine VBA mais j'ai réussit à "créer" un code qui :
- liste les fichiers dans le dossier et sous dossiers "Z:\Mon travail\Bibliothèque\Produits intérieurs\EMH Trolleys\CH200"
- filtre le type de fichier suivant indication dans la cellule F19 (en l'occurrence .dft)
- indique la date de création
- ajout le lien hypertexte
... mais ayant des milliers de fichiers à traiter, c'est beaucoup trop long !!!
emps
Il y aurait il un moyen de réduire le t de traitement ?
(Sachant que je ne filtrer que les fichiers type .dft)
Voici le code ne question :
Option Explicit
Sub ScanClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim L As Long, D As Long
Dim pos As Byte
Dim InitSB As Boolean
InitSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Chemin = "Z:\Mon travail\Bibliothèque\Produits intérieurs\EMH Trolleys\CH200"
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
ThisWorkbook.Sheets("ListeDFT").Range("A2:C65536").Delete Shift:=xlUp
CeFichier = ThisWorkbook.Name
ExtFichier = UCase(Trim(ThisWorkbook.Sheets("ListeDFT").Range("Extension").Text))
L = 1
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers(Chemin, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
Chemin = TabDossiers(D)
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
'Liste les fichiers
L = L + 1
'
Application.StatusBar = "ligne traitée : " & L
'MAJ feuille résultats
With ThisWorkbook.Sheets("ListeDFT")
.Cells(L, 1).Value = Chemin
.Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Chemin & Fichier.Name, _
TextToDisplay:=Fichier.Name
.Cells(L, 3).Value = Fichier.DateCreated
End With
End If
End If
Next
Next D
Columns("B:B").Select
Range("A1:C65536").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Set Dossier = Nothing
'Rétablit l'alerte de lien éventuelle dans les options Excel
Application.ScreenUpdating = True
MsgBox L - 1 & " fichiers trouvés !"
Application.StatusBar = False
'Réinintialise le mode d'affichage de la barre.
Application.DisplayStatusBar = InitSB
End Sub
Private Function lstDossiers(Chemin As String, Optional Debut As Boolean) As Variant
Dim Dossier As Object, SD As Object, D As Object
Static TabTemp() As String
If Debut Then
ReDim TabTemp(1 To 1)
TabTemp(1) = Chemin
End If
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'examen du dossier courant
For Each D In Dossier.subfolders
ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
TabTemp(UBound(TabTemp)) = D.Path
Next
'Traitement récursif des sous-dossiers (d'après un code de F.Sigonneau)
For Each SD In Dossier.subfolders
lstDossiers SD.Path
Next SD
lstDossiers = TabTemp()
Set Dossier = Nothing
End Function
Merci d'avance pour vos reponses
Je dessinateur industriel sur Solid Egde et j'aurais besoins de lister les plans que j'ai créé (fichier.dft).
Je suis plus que novice dans le domaine VBA mais j'ai réussit à "créer" un code qui :
- liste les fichiers dans le dossier et sous dossiers "Z:\Mon travail\Bibliothèque\Produits intérieurs\EMH Trolleys\CH200"
- filtre le type de fichier suivant indication dans la cellule F19 (en l'occurrence .dft)
- indique la date de création
- ajout le lien hypertexte
... mais ayant des milliers de fichiers à traiter, c'est beaucoup trop long !!!
emps
Il y aurait il un moyen de réduire le t de traitement ?
(Sachant que je ne filtrer que les fichiers type .dft)
Voici le code ne question :
Option Explicit
Sub ScanClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String, ExtFichier As String
Dim TabDossiers As Variant
Dim L As Long, D As Long
Dim pos As Byte
Dim InitSB As Boolean
InitSB = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Chemin = "Z:\Mon travail\Bibliothèque\Produits intérieurs\EMH Trolleys\CH200"
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
ThisWorkbook.Sheets("ListeDFT").Range("A2:C65536").Delete Shift:=xlUp
CeFichier = ThisWorkbook.Name
ExtFichier = UCase(Trim(ThisWorkbook.Sheets("ListeDFT").Range("Extension").Text))
L = 1
'Création du tableau des sous-dossiers existants
TabDossiers = lstDossiers(Chemin, True)
For D = 1 To UBound(TabDossiers)
'Chemin du dossier (ou sous-dossier) à analyser
Chemin = TabDossiers(D)
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'Analyse du dossier (ou sous-dossier)
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
If ExtFichier = "" Or UCase(Right(Fichier.Name, 3)) = ExtFichier Then
'Liste les fichiers
L = L + 1
'
Application.StatusBar = "ligne traitée : " & L
'MAJ feuille résultats
With ThisWorkbook.Sheets("ListeDFT")
.Cells(L, 1).Value = Chemin
.Hyperlinks.Add Anchor:=.Cells(L, 2), Address:=Chemin & Fichier.Name, _
TextToDisplay:=Fichier.Name
.Cells(L, 3).Value = Fichier.DateCreated
End With
End If
End If
Next
Next D
Columns("B:B").Select
Range("A1:C65536").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Set Dossier = Nothing
'Rétablit l'alerte de lien éventuelle dans les options Excel
Application.ScreenUpdating = True
MsgBox L - 1 & " fichiers trouvés !"
Application.StatusBar = False
'Réinintialise le mode d'affichage de la barre.
Application.DisplayStatusBar = InitSB
End Sub
Private Function lstDossiers(Chemin As String, Optional Debut As Boolean) As Variant
Dim Dossier As Object, SD As Object, D As Object
Static TabTemp() As String
If Debut Then
ReDim TabTemp(1 To 1)
TabTemp(1) = Chemin
End If
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
'examen du dossier courant
For Each D In Dossier.subfolders
ReDim Preserve TabTemp(1 To UBound(TabTemp) + 1)
TabTemp(UBound(TabTemp)) = D.Path
Next
'Traitement récursif des sous-dossiers (d'après un code de F.Sigonneau)
For Each SD In Dossier.subfolders
lstDossiers SD.Path
Next SD
lstDossiers = TabTemp()
Set Dossier = Nothing
End Function
Merci d'avance pour vos reponses
9 déc. 2008 à 00:38
au vu de vos échanges, sauriez vous me conseiller :
j'ai une feuille qui contient sur 1 colonne des noms de serveurs et sur les 4 colonnes suivantes de 1 à 4 partages existants sur le serveur de cette ligne de la 1ere colonne
Je sais "lire" les serveurs et partages (jusqu'à celulle vide)
par contre, je n'arrive pas à me dépatouiller de la problématique :
je dois compter, sur chacun des \\serveur\partage1à4 les fichiers datés de la veille et en additioner le total, par serveur, que ce soit sur une autre feuille ou non
Voilà, d'avance merci de votre réponse (même négative)
Bien cordialement
9 sept. 2009 à 14:49
Je me permets de venir vous solliciter, car j'ai trouvé sur un site que vous répondiez à quelqu'un pour une macro excel.
Je suis aussi à la recherche d'une macro excel permettant de:
Lister les fichiers de répertoires et sous répertoires, et d'afficher pour chaque fichier dans une colonne différente :
le nom du fichier
le chemin
la taille du fichier
la date de création ou dernière modification,
L'extension du fichier,
...
Avez-vous quelque chose qui pourrait me dépanner?
Je cous remercie par avance de l'attention que vous porterez à ma demande
SLT
AAT
amial@hotmail.fr
9 sept. 2009 à 16:06
Un exemple ici : https://www.cjoint.com/?jjqeU1YwYK
Je me suis inspiré de la FAQ VB6 du site https://vb.developpez.com/
;o)
10 sept. 2009 à 22:07
Je vous remercie bien de votre fichier, cela m’a permis de bien avancer.
J’ai effectivement récupérer ce que j’avais besoin.
J’en ai profité, sur la page de résultat (feuille2) d’ajouter une comparaison conditionnelle qui ma permis de colorier une ligne quand elle identique à celle du dessus ou du dessous (suivant le tri). De façon à trier dans les divers répertoires les fichiers similaires.
Je me retrouve maintenant avec un fichier avec parfois une ou plusieurs ligne colorié à la suite et à chaque fois une ligne normale (non coloriée).
Avez-vous une solution pour ne garder que les lignes identiques (coloriées et la ligne comparée non coloriée).
Je vous remercie par avance de votre aide.
SLT
amial@hotmail.fr
3 déc. 2009 à 08:37
A ce jour j'ai trouvé çà, mais j'ai un bug et je ne sais pas pourquoi...
Sub NombreOctetsRepertoire()
Dim Rep As Object
Set Rep = CreateObject("Scripting.FileSystemObject")
Range("H3") = Rep.GetFolder("\\nom-du-serveur\").Size
End Sub