Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Aide VBA

ThomasVil

XLDnaute Nouveau
Bonjour, je débute en vba et je peine beaucoup. Alors voila mon probleme j'aimerai connaitre les noms ou chemins d'acces de sous dossiers contenues dans un dossies et les afficher dans un userforms avec un listebox ou combobox. J'ai déja reussi a récupérer un code permettant de connaitre les chemins de tout les sous dossiers d'un dossier mais j'aimerai comme je l'ai dit plus haut les afficher dans avec une listebox mais sans les écrire préablement dans des cellules (que ca se fasse automatiquement) ce que fais le code que j'ai.
Voici le code que j'ai déja:

Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next
'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
Set fso = Nothing
End Sub 'fs

Sub test()
TousLesDossiers "C:\Users\Thomas\Desktop\", 0
End Sub

Merci d'avance,
Cordialement, Thomas
 

ThomasVil

XLDnaute Nouveau
Bonjour
Et en remplaçant Cells(Idx, 1).Value = Flder.Path par ListBox1.AddItem Flder.Path ça marche pas ?
Bonjour ca aurait été trop beau il me marque erreur 424 objet requis et savez vous quoi changez a ce code pour qu'il me renvoie les seulement les ous dossiers d'un dossier et non les sous-sous-dossiers aussi? Merci pour votre réponde rapide
Cordialement
 

Dranreb

XLDnaute Barbatruc
Avez vous au moins pensé à rectifier ListBox1 en le vrai nom de votre ListBox ?
Vous pouvez remplacer le paramètre Idx qui ne servira plus par un niveau de profondeur de récursion limite, au delà duquel il n'examinera plus les sous dossiers. Décrémentez celui récupéré pour l'appel récursif et quand il est à 0 ne l'invoquez plus.
 

ThomasVil

XLDnaute Nouveau

Merci de votre réponse
Mais oui j'ai pensé a modifié le nom mais l'erreur est toujours présente et je suis vraiment un debutant en vba ( ça doit se voir) j'ai donc pas réellement compris comment faire avec Idx. Auriez vous un petit exemple si ca vous dérange pas ? Merci de votre réponse
 

ThomasVil

XLDnaute Nouveau
Tres bien , voici donc mon code pour le module
Sub TousLesDossiers(LeDossier$, Idx As Long)
Dim fso As Object, Dossier As Object
Dim sousRep As Object, Flder As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(LeDossier)
'examen du dossier courant
For Each Flder In Dossier.subfolders
Idx = Idx + 1
Cells(Idx, 1).Value = Flder.Path
Next
'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
Set fso = Nothing
End Sub 'fs
Sub test()
TousLesDossiers "C:\Users\Thomas\Desktop\", 0
UserForm1.Show
End Sub
 

Dranreb

XLDnaute Barbatruc
Utilisez donc plutôt le bouton "Téléverser un fichier" pour joindre votre classeur.
Comment ça votre code pour le module ? C'est bien du code de votre UserForm au moins, sinon évidemment la ListBox de votre UserForm n'y est pas connue !
 

ThomasVil

XLDnaute Nouveau
d'accord la j'ai tout mis dans l'userform et j'ai aussi remplacé la ligne dont vous m'aviez parlé au début il y a plus d'erreur 424 mais une erreur 6 disant depassement de capacité. Désolé d'être autant un boulet je suis vraiment perdu. Merci bcp déja pour toute votre aide.
 

Dranreb

XLDnaute Barbatruc
VB:
Private Sub UserForm_Initialize()
    For i = 1 To 4 ' => pour lister les 4 pays
        ComboBox_Pays.AddItem Cells(1, i)
       Next
    TousLesDossiers "C:\Users\Thomas\Desktop\", 2
End Sub

Sub TousLesDossiers(ByVal LeDossier$, ByVal Niv&)
    Dim fso As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(LeDossier)
    'examen du dossier courant
    For Each Flder In Dossier.subfolders
      On Error Resume Next
      Me.ListBox_Villes.AddItem Flder.Path
      Next Flder
    'traitement récursif des sous dossiers
    Niv = Niv - 1: If Niv <= 0 Then Exit Sub
    For Each sousRep In Dossier.subfolders
        TousLesDossiers sousRep.Path, Niv
    Next sousRep
End Sub
 

ThomasVil

XLDnaute Nouveau
Merci beaucoup ca marche =) Si c'est pas trop vous demandez pouvez vous m'aidez avec l'histoire du Idx et de seulement indiquez les sous repertoires et non les sous-sous repertoires? En fait j'ai l'idee de mettre un premier lieux touts les sous repertoires d'un dossier et en fonction de celui selectionné je voudrai afficher ses sous-dossier mais je sais pas trop comment m'y prendre déja si vous poucez m'indiquez comment affichez seulement les sous repertoire et non les sous-sous ca serait déja genial
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…