Liste arborescence et nommage fichier
Résolu
mvery
Messages postés
20
Date d'inscription
mercredi 26 octobre 2005
Statut
Membre
Dernière intervention
5 novembre 2009
-
8 mars 2006 à 13:54
cs_Willi Messages postés 2375 Date d'inscription jeudi 12 juillet 2001 Statut Modérateur Dernière intervention 15 décembre 2018 - 11 mars 2006 à 01:10
cs_Willi Messages postés 2375 Date d'inscription jeudi 12 juillet 2001 Statut Modérateur Dernière intervention 15 décembre 2018 - 11 mars 2006 à 01:10
A voir également:
- Liste arborescence et nommage fichier
- Fichier .ini - Conseils pratiques -Visual Basic / VB.NET
- Fichier json - Conseils pratiques -Javascript
- Traitement dédoublonnage fichier ✓ - Forum C++ & C++ .NET
- Extension fichier c# ✓ - Forum C# / .NET
- Vba écrire dans un fichier texte - Conseils pratiques -Visual Basic / VB.NET
5 réponses
cs_Willi
Messages postés
2375
Date d'inscription
jeudi 12 juillet 2001
Statut
Modérateur
Dernière intervention
15 décembre 2018
22
9 mars 2006 à 01:15
9 mars 2006 à 01:15
Ré,
Le code est commenté, je ne réxplique pas
N'oublis pas de remplacer "c:\TonDossier" par ton lecteur à scanner ou ton rép à scanner
Pour un lecteur n'oublis pas le \ après le c:
Déclaration globale des variables
8<----------------------------------------------------------
Dim colRep As New Collection
Dim colFich As New Collection
Dim scurfich As String
Dim scurdoss As String
---------------------------------------------------------->8
A mettre par exemple dans un bouton
8<----------------------------------------------------------
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'fichier racine du répertoire
For Each fichier In fso.GetFolder("c:\TonDossier").Files
'Comparaison de la longeur du fichier
'Si dépasse 64 caractères on ajoute à la collection
scurfich = fichier
If Len(GetFilename(scurfich)) > 64 Then colFich.Add fichier
Next
'dossier racine
For Each dossier In fso.GetFolder("c:\TonDossier").SubFolders
scurdoss = dossier
RecurSubFolder scurdoss
Next
Set fso = Nothing
'Envois dans un fichier les listes fichiers et repertoires
Dim i As Long
Dim ff As Long
ff = FreeFile
Open "c:\resultat.txt" For Output As #ff
Print #ff, "Nom des fichiers trouvés supérieur à 64 caractères" & vbCrLf & "---------------------------------------" & vbCrLf
For i = 1 To colFich.Count
Print #ff, colFich(i)
Next
Print #ff, vbCrLf & vbCrLf
Print #ff, "Nom des répertoires trouvés supérieur à 256 caractères" & vbCrLf & "---------------------------------------" & vbCrLf
For i = 1 To colRep.Count
Print #ff, colRep(i)
Next
Close #ff
---------------------------------------------------------->8
Fonctions utilisés ci-dessus
8<----------------------------------------------------------
'Récupère le nom d'un fichier dans un chemin
Function GetFilename(fichier As String) As String
'Position du dernier '\' qui va déterminer la position du nom du fichier
Dim pos As Integer
pos = InStrRev(fichier, "")
GetFilename = Mid$(fichier, pos + 1, Len(fichier))
End Function
'Méthode récursive qui parcours les dossiers, sous-dossiers....
Sub RecurSubFolder(folder As String)
On Error Resume Next 'Juste au cas ou l'accès à un dossier serait refusé.
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Parcourt les fichiers du dossier courant
For Each fichier In fso.GetFolder(folder).Files
'Comparaison de la longeur du fichier
'Si dépasse 64 caractères on ajoute à la collection
scurfich = fichier
If Len(GetFilename(scurfich)) > 64 Then colFich.Add fichier
Next
'Idem pour les dossiers sauf si il n'y a pas de sous-dossiers
If fso.GetFolder(folder).SubFolders.Count <> 0 Then
For Each dossier In fso.GetFolder(folder).SubFolders
'Comparaison de la longeur du fichier
'Si dépasse 256 caractères on ajoute à la collection
scurdoss = dossier
If Len(dossier) > 256 Then colRep.Add dossier
RecurSubFolder (dossier)
Next
End If
End Sub
---------------------------------------------------------->8
Voila.
Bon courage
Le code est commenté, je ne réxplique pas
N'oublis pas de remplacer "c:\TonDossier" par ton lecteur à scanner ou ton rép à scanner
Pour un lecteur n'oublis pas le \ après le c:
Déclaration globale des variables
8<----------------------------------------------------------
Dim colRep As New Collection
Dim colFich As New Collection
Dim scurfich As String
Dim scurdoss As String
---------------------------------------------------------->8
A mettre par exemple dans un bouton
8<----------------------------------------------------------
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'fichier racine du répertoire
For Each fichier In fso.GetFolder("c:\TonDossier").Files
'Comparaison de la longeur du fichier
'Si dépasse 64 caractères on ajoute à la collection
scurfich = fichier
If Len(GetFilename(scurfich)) > 64 Then colFich.Add fichier
Next
'dossier racine
For Each dossier In fso.GetFolder("c:\TonDossier").SubFolders
scurdoss = dossier
RecurSubFolder scurdoss
Next
Set fso = Nothing
'Envois dans un fichier les listes fichiers et repertoires
Dim i As Long
Dim ff As Long
ff = FreeFile
Open "c:\resultat.txt" For Output As #ff
Print #ff, "Nom des fichiers trouvés supérieur à 64 caractères" & vbCrLf & "---------------------------------------" & vbCrLf
For i = 1 To colFich.Count
Print #ff, colFich(i)
Next
Print #ff, vbCrLf & vbCrLf
Print #ff, "Nom des répertoires trouvés supérieur à 256 caractères" & vbCrLf & "---------------------------------------" & vbCrLf
For i = 1 To colRep.Count
Print #ff, colRep(i)
Next
Close #ff
---------------------------------------------------------->8
Fonctions utilisés ci-dessus
8<----------------------------------------------------------
'Récupère le nom d'un fichier dans un chemin
Function GetFilename(fichier As String) As String
'Position du dernier '\' qui va déterminer la position du nom du fichier
Dim pos As Integer
pos = InStrRev(fichier, "")
GetFilename = Mid$(fichier, pos + 1, Len(fichier))
End Function
'Méthode récursive qui parcours les dossiers, sous-dossiers....
Sub RecurSubFolder(folder As String)
On Error Resume Next 'Juste au cas ou l'accès à un dossier serait refusé.
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Parcourt les fichiers du dossier courant
For Each fichier In fso.GetFolder(folder).Files
'Comparaison de la longeur du fichier
'Si dépasse 64 caractères on ajoute à la collection
scurfich = fichier
If Len(GetFilename(scurfich)) > 64 Then colFich.Add fichier
Next
'Idem pour les dossiers sauf si il n'y a pas de sous-dossiers
If fso.GetFolder(folder).SubFolders.Count <> 0 Then
For Each dossier In fso.GetFolder(folder).SubFolders
'Comparaison de la longeur du fichier
'Si dépasse 256 caractères on ajoute à la collection
scurdoss = dossier
If Len(dossier) > 256 Then colRep.Add dossier
RecurSubFolder (dossier)
Next
End If
End Sub
---------------------------------------------------------->8
Voila.
Bon courage
cs_Willi
Messages postés
2375
Date d'inscription
jeudi 12 juillet 2001
Statut
Modérateur
Dernière intervention
15 décembre 2018
22
8 mars 2006 à 15:07
8 mars 2006 à 15:07
Petite précision. vb6 ? vba ? vb.net ?
mvery
Messages postés
20
Date d'inscription
mercredi 26 octobre 2005
Statut
Membre
Dernière intervention
5 novembre 2009
8 mars 2006 à 23:30
8 mars 2006 à 23:30
en vb6
mvery
Messages postés
20
Date d'inscription
mercredi 26 octobre 2005
Statut
Membre
Dernière intervention
5 novembre 2009
10 mars 2006 à 10:12
10 mars 2006 à 10:12
Mille Merci a toi Willi
On ecrira des chansons sur toi ...
On ecrira des chansons sur toi ...
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_Willi
Messages postés
2375
Date d'inscription
jeudi 12 juillet 2001
Statut
Modérateur
Dernière intervention
15 décembre 2018
22
11 mars 2006 à 01:10
11 mars 2006 à 01:10
J'ai hâte de l'entendre...
