VBA - ExcelRésolu

Question

Bonjour,

Je débute dans VBA sous excel.  Grâce au site, j'ai déjà pu créer une macro me permettant d'insérer les photos d'un dossier donné dans une feuille excel et, sous une certaine présentation.

J'aimerais maintent affiner l'utilisation de cette macro et la rendre plus conviviale par l'utilisation d'un userform qui me permettrait de choisir un utilisateur.  En fonction de cet utilisateur, je saurais dans quel répertoire je dois ensuite "travailler".  Le choix de l'utilisateur conditionnerait les valeurs qui apparaîtraient dans une combobox en-dessous.  Cette combobox devrait lister tous les sous-répertoires de l'utilisateur.  La sélection d'une valeur dans la combobox me permettrait alors de dédifinir le répertoire dans lequel je vais chercher les fichiers jpg à insérer dans ma feuille (cette dernière partie est ok).

Je pense que lister les fichiers d'un répertoire a déjà été expliqué.  Ce qu'il me faudrait, c'est comment lister les sous répertoires. Merci d'avance pour votre aide.

cs_Orohena · Accepted Answer

Bonjour Rodavaflo & Co

Voici un programme VBA qui liste tous les sous_repertoires d'un repertoire "c:\...\utilisateur" dans une ListBox. Je l'ai dérivé d'une discussion en cours sur ce forum et traitant, à peu de choses près, du même sujet.

Sub lister_repertoires_utilisateur()
    Dim liste As String, ligne As Integer, chemin As String
    Dim userDir As String
    userDir = "c:\...\utilisateur"   ' à modifier
    recurseListeSousRep userDir, liste
    ligne = 1
    Do
        chemin = Left(liste, InStr(1, liste, ";"))
        liste = Replace(liste, chemin, "", 1, 1)
        chemin = Replace(chemin, userDir & "", "", 1, 1)
        Cells(ligne, 1).Value = Replace(chemin, ";", "", 1)
        ligne = ligne + 1
    Loop Until liste = ""
    ListBox.RowSource = "A1:A" & Trim(Str(ligne - 1))
End Sub



Sub recurseListeSousRep(rep As String, liste As String)
'
' liste récursivement les sous-repertoires du repertoire rep
'
    Dim fileSys             ' objet representant le systeme de fichiers
    Dim repertoireCourant   ' objet Folder representant le repertoire courant
    Dim sousRepertoires     ' objet Folders representant les sous-repertoires
    Dim sousRepertoire      ' objet Folder representant l'un des sous-repertoires
    Dim sep As String       ' separateur ("" pour Windows)
    Dim cible As String     ' chemin du fichier dans le repertoire courant
    Dim Erreur As Boolean
'    MsgBox liste
    sep = Application.PathSeparator
    Set fileSys = CreateObject("Scripting.fileSystemObject")
' creer un objet Folder representant le repertoire courant
    Set repertoireCourant = fileSys.getfolder(rep)
' creer une collection Folders representant les sous-repertoires
    Set sousRepertoires = repertoireCourant.subfolders
' balayer la collection en creant un objet Folder pour chaque sous-repertoire
    On Error GoTo erreurAccesRep
    Erreur = False
    For Each sousRepertoire In sousRepertoires
' recherche le fichier par iteration
        If Not Erreur Then
            liste = liste & rep & sep & sousRepertoire.Name & ";"
            recurseListeSousRep rep & sep & sousRepertoire.Name, liste
        End If
    Next
    On Error GoTo 0
    Exit Sub
erreurAccesRep:
    Erreur = True
    Resume Next
End Sub



Cordialement

pile_poil · Answer

bonjour 
regardes dans l'aide  (F1) 
Dir
il y a des exemples qui répondent exactement à ton probleme

[reglement.aspx ]si c'est la solution, penser : REPONSE ACCEPTEE

Iraitika · Answer

Bonjour, voici un exemple en .NET qui doit pouvoir être adapté en VBA

Dim TableauRepertoire(5) as String
    Dim NomDossier as String    
    Dim dossier As String
    For Each dossier In my.Computer.FileSystem.GetDirectories("C:\Users\**\Desktop\versions")
    TableauRepertoire = dossier.Split("")
    NomDossier = TableauRepertoire(5)
    If NomDossier.StartsWith("V") Then
        Cb_Version.Items.Add(NomDossier)
    End If
    Next
    Cb_Version.SelectedIndex = 0

Ce bout de code permet la récupération du sous répertoire. De garder uniquement son cinquième mot et de l'ajouter à la combobox si ce dernier commence par V.

En esperant avoir compris la question. ;);)

PROTEUS91 · Answer

Hello Roda, Je te passe une procedure que j'utilise sous VB pour lister les fichiers, les repertoires et les sous repertoires, je ne sais pas si ca marche sous VBA, mais je pense que ca doit etre pareille. 1. Tu copie cette procedure Comme elle est Public Sub PROCEDURE_RECURSETREE(Current_Path As String, Use_Form As Form, ListBox_File As Object, Clear_ListBox As Boolean, Optional ListBox_Racine As Object, Optional Recup_UnderFolder As Boolean = False) Dim Integer_N, Integer_Directory As Integer Dim String_FileName, String_DirectoryList() As String DoEvents If Clear_ListBox = True Then 'Reset les differentes Liste ListBox_File.Clear 'Reset la liste Fichier ListBox_Racine.Clear 'Reset la liste Racine End If String_FileName = Dir(Current_Path) Do While String_FileName <> "" 'Tant que ce sont des fichiers String_Complete = Current_Path & String_FileName 'PathName dans la variable If String_FileName <> "" Then ListBox_Racine.AddItem (Current_Path) 'Ajoute l'evenement ListBox_File.AddItem (String_FileName) 'Ajoute l'evenement End If String_FileName = Dir Loop String_FileName = LCase(Dir(Current_Path, vbDirectory)) 'Assigne le repertoire a analyser Do While String_FileName <> "" 'Tant que la variable ne contient pas de fichier If String_FileName <> "." And String_FileName <> ".." And String_FileName <> "pagefile.sys" Then If GetAttr(Current_Path & String_FileName) And vbDirectory Then Integer_Directory = Integer_Directory + 1 'Compte le nombres de sous dossiers ReDim Preserve String_DirectoryList(Integer_Directory) 'Ajoute dans un tableau temporaire le sous dossier String_DirectoryList(Integer_Directory) = Current_Path & String_FileName End If End If String_FileName = Dir LoopIf Recup_UnderFolder True Then 'Si UnderFolder True then For Integer_N = 1 To Integer_Directory 'Boucle la procedure pour lister les sous repertoire PROCEDURE_RECURSETREE String_DirectoryList(Integer_N) & "", Use_Form, ListBox_File, False, ListBox_Racine, True Next Integer_N End If End Sub 2. La ligne de code qui te permet d'utiliser la procedure. PROCEDURE_RECURSETREE "C:\windows", Me, List1, False, List2, True 3. Avant de lancer la ligne de code pense a crée deux ListBox, List1 contient les noms de fichier, List2 contient les noms des repertoires. Normalement tu as tout. J'espere que ca marchera. Bonne chance. PROTEUS

jrivet · Answer

Salut,
Sinon il faut chercher sur www.codyx.org

il y a:
http://www.codyx.org/snippet_liste-tous-fichiers-disque-dur_426.aspx

ou bien encore

http://www.codyx.org/snippet_lister-sous-repertoires-ou-sous-sous-repertoires-repertoire_260.aspx

@+: Ju£i€n
Pensez: Réponse acceptée

RODAVAFLO · Answer

Merci pour l'aide.  La fonction Dir me renvoie bien un nom de répertoire.  Par contre, il faut que je puisse prendre tous les noms de répertoires et je ne connais pas une fonction qui me permette de les compter !

jrivet · Answer

Je reposte la meme chose à voir si maintenant cela passe mieux et si tu nous en dit un peu plus...

Salut,
Sinon il faut chercher sur www.codyx.org

il y a:
http://www.codyx.org/snippet_liste-tous-fichiers-disque-dur_426.aspx

ou bien encore

http://www.codyx.org/snippet_lister-sous-repertoires-ou-sous-sous-repertoires-repertoire_260.aspx

@+: [../c.aspx?u=aHR0cDovL3d3dy5teXNwYWNlLmNvbS9hcG9zdGFzeTIx Ju£i€n]
Pensez: Réponse acceptée 

@+: Ju£i€n
Pensez: Réponse acceptée

RODAVAFLO · Answer

Merci à tous pour votre aide.  J'ai enfin réussi à réaliser ce que je voulais.  Si quelqu'un veut le programme, je peux le joindre.  je me suis fort inspirée de la solution d'Orohena.  J'ai été un peu lente à la résolution, mais je n'ai pas beaucoup de temps à y consacrer.  Mes collègues qui vont utiliser l'application sont super contents du résultat, c'est ce qui compte.

Bien à vous,

VBA - Excel

8 réponses

Votre réponse

Discussions similaires