Aide VBA

ThomasVil · 28 Juin 2018

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

Dranreb · 28 Juin 2018

Bonjour
Et en remplaçant Cells(Idx, 1).Value = Flder.Path par ListBox1.AddItem Flder.Path ça marche pas ?

ThomasVil · 28 Juin 2018

Dranreb à dit:
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 · 28 Juin 2018

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 · 28 Juin 2018

Dranreb à dit:
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.

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

Dranreb · 28 Juin 2018

Non, c'est à vous de joindre votre classeur.

ThomasVil · 28 Juin 2018

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 · 28 Juin 2018

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 · 28 Juin 2018

heu en fait vous allez voir mais j'ai du code de module qui va appeller le code de l'userforms

Dranreb · 28 Juin 2018

Non, faites tout dans l'UserForm. Là la ListBox n'est même pas définie tant que l'UserForm n'est pas chargé.

ThomasVil · 28 Juin 2018

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 · 28 Juin 2018

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 · 28 Juin 2018

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

ThomasVil · 28 Juin 2018

Oups désolé j'avais lancé le mauvais programme merci infiniment

Aide VBA

ThomasVil

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

ThomasVil

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

ThomasVil

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

ThomasVil

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

ThomasVil

XLDnaute Nouveau

Pièces jointes

Dranreb

XLDnaute Barbatruc

ThomasVil

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

ThomasVil

XLDnaute Nouveau

ThomasVil

XLDnaute Nouveau

Discussions similaires