Discussion :

[mattwarend]

Bonjour à tous,

Une nouvelle fois je sollicite votre aide...
Je cherche à réaliser une macro pour compter le nombre de caractère des répertoires (uniquement répertoires et pas les fichiers) dans un emplacement précis.
L'idéale serait que je puisse dire de me remonter uniquement les répertoires dont le nombre de caractères est supérieur à 15 caractères.

Merci d'avance pour votre aide.
@+

[ucfoutu]

Bonsoir,

Précise : le nombre de caractères des répertoires ou celui du nom des répertoires ?

Edit :

Bon (je pense que tu parlais du nom du répertoire et non du répertoire)

Alors voilà :

Un bouton de commande Command1 et une listbox nommée List1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
Private Sub Command1_Click()
   Dim repertoire As String, maxcar As Integer
   repertoire = "d:\monoutil" ' ici ton répertoire à fouiller
   maxcar = 8 ' ici le nombre maximum de caractères
   cherchons repertoire, maxcar
End Sub
 
Sub cherchons(ByVal rep As String, nbmax As Integer)
  Dim nf As String, nbr As Integer
  Dim tremplin As String
  Dim i As Integer
  If Right$(rep, 1) <> "\" Then rep = rep & "\"
  nf = Dir$(rep, vbDirectory)
  nbr = 1
  Do While nf <> ""
    If nf <> "." And nf <> ".." Then
      tremplin = rep & nf
      If GetAttr(tremplin) And vbDirectory And Len(nf) > nbmax Then
        List1.AddItem tremplin
        cherchons tremplin, nbmax
        nf = Dir$(rep, vbDirectory)
        For i = 2 To nbr
          nf = Dir$
        Next
      End If
    End If
    nf = Dir$
    nbr = nbr + 1
  Loop
End Sub

[mattwarend]

Salut !
Merci ! Je parlais effectivement de compter le nombre de caractères dans le nom des répertoires.

J'ai copié/collé ton code dans une nouvelle macro, je ne sais pas comment et où l'intégrer pour que ça fonctionne.
Maintenant, quand je la lance, il me demande le nom de la macro ?

@+

[ucfoutu]

salut,

teste mon exemple à partir d'un userform dans lequel tu installes un bouton de Commande Command1 et une listbox List1

Mets tout le code dans la partie code de ton userform.

Maintenant : si tu veux une macro indépendante :

Il te suffit d'adapter ce code !
Je n'ai actuellement pas Excel sous la main, mais la chose me parait simple à faire ! Non ?

[mattwarend]

Je débute, je vais essayer. Je ne sais pas trop comment procéder, je n'ai jamais fait de userform. Je vais chercher.
Merci.
@+

[ucfoutu]

vas-y ... c'est simple...

Il est également simple, si tu le veux
- d'utiliser des inputboxes pour saisir le répertoire à traiter et pour saisir le nombre maximum de caractères
- d'utiliser autre chose qu'une listbox (tu peux même utiliser des cellules de ta feuille) pour afficher les résultats.
Moi, je t'ai montré le mécanisme (la sauce). Tu utilises ensuite cette sauce avec le mets de ton choix !

[zandru]

Je débute, je vais essayer. Je ne sais pas trop comment procéder, je n'ai jamais fait de userform. Je vais chercher.

Si tu n'a jamais fait de userform, voici une lecture qui te sera très utile :
Userform

[mattwarend]

Salut,

J'ai donc créé un Userform avec un bouton de commande Command1 et une listbox nommée List1.
Une fois réalisé, je lance et là je recontre le message suivant :
Erreur 52 Nom ou n° de fichier incorrect.

Je clique sur débogage et il bloque sur la ligne suivante :

nf = Dir$(rep, vbDirectory)

Ci-joint le code complet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
Option Explicit
Private Sub Command1_Click()
   Dim repertoire As String, maxcar As Integer
   repertoire = "c:\" ' ici ton répertoire à fouiller
   maxcar = 2 ' ici le nombre maximum de caractères
   cherchons repertoire, maxcar
End Sub
 
Sub cherchons(ByVal rep As String, nbmax As Integer)
  Dim nf As String, nbr As Integer
  Dim tremplin As String
  Dim i As Integer
  If Right$(rep, 1) <> "\" Then rep = rep & "\"
  nf = Dir$(rep, vbDirectory)
  nbr = 1
  Do While nf <> ""
    If nf <> "." And nf <> ".." Then
      tremplin = rep & nf
      If GetAttr(tremplin) And vbDirectory And Len(nf) > nbmax Then
        List1.AddItem tremplin
        cherchons tremplin, nbmax
        nf = Dir$(rep, vbDirectory)
        For i = 2 To nbr
          nf = Dir$
        Next
      End If
    End If
    nf = Dir$
    nbr = nbr + 1
  Loop
End Sub
 
Private Sub CommandButton1_Click()
 
End Sub

[ucfoutu]

C'est tout simplement parcequ'en fouillant tout C:\, tu arrives nécessairement à des répertoires particuliers (par exemple chez moi, Winnt, chez toi, peut-être, Windows) qui contiennent des fichiers système !

Ne prends bien évidemment pas la totalité de C:\ !!!
Essaye par exemple avec "C:\psfonts"

EDIT : maintenant : si tu y tiens VRAIMENT, à farfouiller dans tout ton C:\ (et je te le déconseille), ajoute alors simplement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error Resume Next

juste avant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If GetAttr(tremplin) And vbDirectory And Len(nf) > nbmax Then

et prépare-toi à patienter, car TOUT C:\, ce n'est pas une goutte d'eau, hein ...

[mattwarend]

Super merci ! j'ai essayé dans "C:\Program Files" et ça fonctionne.
Maintenant, comment faire pour enregistrer les résultats dans la feuille ?
@+

[ucfoutu]

Super merci ! j'ai essayé dans "C:\Program Files" et ça fonctionne.
Maintenant, comment faire pour enregistrer les résultats dans la feuille ?
@+

Cà, vois-tu, je te le laisse (tu dois y arriver) ...
Moi, j'ai traité "la sauce" et te laisse là ... (c'est à ta portée).
Amitiés.

[mattwarend]

Ho la la ! Dur dur
Je vais chercher mais je n'ai aucune idée pour le moment.
Merci en tout cas !
@+

[ucfoutu]

C'est quand-même facile ...
Allez : deux indications :
la ligne qui dit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 List1.AddItem tremplin

ajoute un article dans la listbox
Si tu la remplaces par une instruction pour écrire dans une cellule de ta feuille, elle y écrira !

Tu ne veux bien sur par tout écrire dans la même cellule ...
Alors ?
==>> tu ajoutes un compteur (appelons-le toto)
tu initialises toto à 1 au début de la procédure cherchons

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
dim toto as integer
toto = 1

puis (à l'endroit du code montré plus haut) :
- tu écris dans la cellule correspondant à la colonne de ton choix et à la ligne toto (facile, non ?)
par exemple (si ta feuille se nomme feuil1:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Cells(toto, 1).Value = tremplin

puis tu augmentes toto pour que la prochaine écriture se fasse dans la colonne suivante, ainsi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

toto = toto + 1

Voilà de quoi t'y mettre... pour l'instant (car tu me ferais plaisir en te dépatouillant pour ne pas utiliser ni l'UserForm, ni le bouton de commande... plus tard...).
Allez ! courage et ne recule pas ! Le développement n'est pas ce que l'on en dit, mais un amusement.
Je considère t'en avoir dit plus que nécessaire.

[mattwarend]

Hello,

Voilà le code que j'ai modifié, sans succès.
Suis quand même content parce que ça plante pas
Bon OK, ça ne fait pas du tout ce que je veux... Mais au moins, ça marche !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
Option Explicit
Private Sub Command1_Click()
   Dim repertoire As String, maxcar As Integer
   repertoire = "C:\Program Files" ' ici ton répertoire à fouiller
   maxcar = 2 ' ici le nombre maximum de caractères
   cherchons repertoire, maxcar
End Sub
 
Sub cherchons(ByVal rep As String, nbmax As Integer)
Dim toto As Integer
toto = toto + 1
  Dim nf As String, nbr As Integer
  Dim tremplin As String
  Dim i As Integer
  If Right$(rep, 1) <> "\" Then rep = rep & "\"
  nf = Dir$(rep, vbDirectory)
  nbr = 1
  Do While nf <> ""
    If nf <> "." And nf <> ".." Then
      tremplin = rep & nf
      If GetAttr(tremplin) And vbDirectory And Len(nf) > nbmax Then
        Sheets("Feuil1").Cells(toto, 1).Value = tremplin
        cherchons tremplin, nbmax
        nf = Dir$(rep, vbDirectory)
        For i = 2 To nbr
          nf = Dir$
        Next
      End If
    End If
    nf = Dir$
    nbr = nbr + 1
  Loop
End Sub
 
Private Sub CommandButton1_Click()
 
End Sub

[JackOuYA]

bonjour,

j'ai beau relire je comprends pas le but du code : c'est quoi obtenir dans une feuille excel tous les noms de répertoires inférieurs à 15 caractéres ? de ton disque ? où les chemins (plusieurs répertoires) inférieur à 15 ?

[mattwarend]

Le but est de remonter tous les répertoires dont le nombre de caractères (du nom du répertoire) est supérieur à une valeur (2 dans mon exemple).

[JackOuYA]

Pour simplifier ton code utilise la référence Microsoft Scripting runtime (à cocher dans outils référence), et une fonction récursive.

modifie la constante LGMAX, le répertoire "d:\tmp", et la feuille excel "feuil1", à ta guise :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Dim yaF As Worksheet 'Feuille resultat
Dim i As Integer 'Ligne
Dim oFso As New Scripting.FileSystemObject
Const LGMAX = 10
Sub YaLAnce()
 Dim rep As Scripting.Folder
 
 'prépare feuille résultat :
 i = 1
 Set yaF = ThisWorkbook.Sheets("Feuil1")
 
 For Each rep In oFso.GetFolder("d:\tmp\").SubFolders
   YaParcours rep
 Next
MsgBox "Terminé"
End Sub
 
'
' La fonction récursive
'
Sub YaParcours(yaRep As Scripting.Folder)
   Dim yaSubRep As Scripting.Folder
   If Len(yaRep.Name) < LGMAX Then
      yaF.Cells(i, 1) = yaRep.Name
      i = i + 1
   End If
   For Each yaSubRep In yaRep.SubFolders
     YaParcours yaSubRep
   Next
End Sub

[ucfoutu]

Bonjour, matwarend,

là où tu as mis toto, tu écris tes resultats dans des cellules pouvant être très éloignées l'une de l'autre !!!...

voilà comment modifier (fais un copier/coller) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub cherchons(ByVal rep As String, nbmax As Integer)
Dim toto As Integer
  if toto = 0 then toto =  1 ' <<<<<<<<<<<<<======== ICI
  Dim nf As String, nbr As Integer
  Dim tremplin As String
  Dim i As Integer
  If Right$(rep, 1) <> "\" Then rep = rep & "\"
  nf = Dir$(rep, vbDirectory)
  nbr = 1
  Do While nf <> ""
    If nf <> "." And nf <> ".." Then
      tremplin = rep & nf
      If GetAttr(tremplin) And vbDirectory And Len(nf) > nbmax Then
        Sheets("Feuil1").Cells(toto, 1).Value = tremplin
        toto = toto + 1 <<<<==== et ICI
        cherchons tremplin, nbmax
        nf = Dir$(rep, vbDirectory)
        For i = 2 To nbr
          nf = Dir$
        Next
      End If
    End If
    nf = Dir$
    nbr = nbr + 1
  Loop
End Sub

[mattwarend]

Super !!! Merci, merci pour ton (votre) aide !
ca fonctionne maintenant.
J'ai juste ce Userform qui ne me sert plus à grand chose en fait.
@+

[ucfoutu]

Rien te t'interdit de bazarder cette UserForm, maintenant ... (il n'a servi que d'exemple !)
Il te suffit de ne garder que la fonction dans une macro et de quoi l'appeler depuis ta feuille (avec ses paramètres), puisque tu n'écris les résultats que sur ta feuille ...