VBA lister dossiers

Bonjour,

Comment faire un "dir" d'un répertoire pour obtenir les noms des dossiers en VBA ?

J'ai trouvé un truc sur le forum hardware mais je n'arrive pas à l'arranger à ma sauce...

Pouvez vous m'aider ?

je n'ai pas encore de code, je ne sais pas comment faire....

Même un début de macro m'interesse,

D'avance merci,

Souri84

Bonjour souri84

Voilà un file sur le sujet qui pourrait t'intéresser. C'est un début.

https://www.excel-pratique.com/forum/viewtopic.php?t=2284

Amicalement

Dan de pic

Merci Dan de Pic,

Je vais exploiter cela !

Je viens de regarder, mais ce n'est pas exactement ça, j'aimerais faire une sorte de "dir" d'un répertoire pour importer dans une feuille Excel les noms de dossiers (et pas de fichiers) contenu dans ce répertoire...

D'avance merci à qui m'aidera,

Souri84

voici un début de code mais il ne fonctionne pas....

Sub test()
'********
'importer les noms de dossiers
'********

'déclarations des variables
Dim Rep As String
Dim dossiers As String

'dir du dossiers selectionné
Range("B4").Select
Rep = ActiveCell.Value & ":mon répertoire"
dossiers = Dir(Rep, vbDirectory)

'mettre les noms de dossiers les uns en dessous des autres
For i = 1 to ... 'la je ne sais pas quoi mettre...

End Sub

Selon les pros du VBA, mon code est-il bien parti ? je galère à fond....

Bonjour,

Voici un code qui marche que j'ai du trouver sur un forum il y a des annees et dont j'ai adapter pour y inserer un lien hypertexte à souhait

Private Sub CommandButton2_Click()

'Permet de fournir la liste des sous dossier dans un dossier

a = InputBox("Collez ici l'adresse du dossier considéré", "Optimisation", "F:\Envoi")
b = InputBox("Voulez vous le lien hypertexte", "Disponible uniquement sur PC", "NON")

If a = "" Then
Exit Sub
End If

MsgBox ("Adresse du dossier considéré?" & a)

    Dim fs, f, f1, s, sf
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(a)
    Set sf = f.SubFolders

    For Each f1 In sf
        s = f1.Name
        Sheets("Feuil1").Select

        'Ecriture en dessous de la ligne 6
        Cells(6 + i, 1).Select
        ActiveCell.FormulaR1C1 = s

        'MsgBox (a & "\" & s)
        If b = "oui" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=a & "\" & s, _
        TextToDisplay:=s
        End If

   i = i + 1
   Next

MsgBox ("Rapide et efficace")
Exit Sub

End Sub

Private Sub CommandButton1_Click()
'Permet de fournir la liste totale des fichier dans un dossier

c = InputBox("Adresse du dossier considéré", "Optimisation", "C:\Documents and Settings\Administrateur\Bureau\envoie de document")
d = InputBox("Voulez vous le lien hypertexte", "Disponible uniquement sur PC", "NON")
If c = "" Then
Exit Sub
End If

Cells(4, 2) = c

MsgBox ("Coller ici l'adresse du dossier considéré " & c)

    Dim fs, f, f1, fc, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(c)
    Set fc = f.Files

    For Each f1 In fc
        s = f1.Name
        Sheets("Feuil1").Select

        'Ecriture en dessous de la ligne 6
        Cells(6 + i, 2).Select
        ActiveCell.FormulaR1C1 = s

        'MsgBox (a & "\" & s)
        If d = "oui" Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=c & "\" & s, _
        TextToDisplay:=s
        End If

    i = i + 1
    Next

    MsgBox ("Rapide et efficace")

End Sub

Re bonjour

Par contre ci l'adresse par défaut n'existe pas il met un message d'erreur

Salut le forum

Voila le code miracle

Sub Lister_Dossier()

    Dim Chemin As String
    Dim NomRep As String

    Chemin = "C:\Excel\"    ' Définit le chemin d'accès.
    NomRep = Dir(Chemin, vbDirectory)    ' Extrait la première entrée.

    Do While NomRep <> ""    ' Commence la boucle.
         If NomRep <> "." And NomRep <> ".." Then    ' Vérifie que NomRep est un dossier.
            If (GetAttr(Chemin & NomRep) _
                And vbDirectory) = vbDirectory Then
                MsgBox Chemin & NomRep    ' Affiche le dossier
            End If
        End If
        NomRep = Dir    ' Extrait l'entrée suivante.
    Loop

End Sub

Mytå

merci Myta, mais j'ai remanié un peu le code d'Excel Novice et c ok...

Je vais quand même le garder sous le coude au cas ou....

edition n°2:

je viens de tester ton code et j'ai une erreur sur

 If (GetAttr(Chemin & NomRep) _
                And vbDirectory) = vbDirectory Then

A bientôt,

Souri84

Re Souri84

Essaye en enlevant le "Underscore"

If (GetAttr(Chemin & NomRep) And vbDirectory) = vbDirectory Then

Mytå

Bonsoir

Un fichier à la base de J boisgontier

https://www.excel-pratique.com/~files/doc/arborescence.zip

Myta, ça ne fonctionne toujours pas... mais c pas grave, merci de t'être intéréssé à mon problème...

Re le forum

Souri84 tu dois faire une erreur sur la variable Chemin

Chemin = "C:\Excel\"

Elle doit absolument finir par un "Backslash"

Sinon, tu peux ajouter une condition pour en vérifier la présence

If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"

Mytå

aaaaahhhh d'accord, tu as raison, c ça, je n'avais pas mis d'antislash....

UN GRAND MERCI !!!!!!!!