1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources VBA
  5. Explorateur de fichiers vba (le drive+dir+filelistbox du vb)

Explorateur de fichiers vba (le drive+dir+filelistbox du vb)

Soyez le premier à donner votre avis sur cette source.

Vue 19 065 fois - Téléchargée 1 107 fois

Télécharger le projet
Commenter

Description

L'objectif de ce code est d'afficher les fichiers sous la forme d'un explorateur.

Source / Exemple : 


'Fonction de tri d'une liste dans l'ordre alphabétique
Public Function Prog_tri_croissant(ByRef Var_liste())

  For Var_compteur1 = LBound(Var_liste) To UBound(Var_liste) - 1
    For Var_compteur2 = Var_compteur1 + 1 To UBound(Var_liste)
      If Var_liste(Var_compteur1) > Var_liste(Var_compteur2) Then
        Var_temp = Var_liste(Var_compteur2)
        Var_liste(Var_compteur2) = Var_liste(Var_compteur1)
        Var_liste(Var_compteur1) = Var_temp
      End If
    Next Var_compteur2
  Next Var_compteur1

'Affectation de la valeur finale au programme pour qu'il retourne
'la liste dans l'ordre croissant lorsque l'on fait appel à lui
Prog_tri_croissant = Var_liste()

End Function

'Programme d'affichage des répertoires et des fichiers
Sub Prog_affichage_rep_et_fichier()

  Var_chemin = TextBox1.Value
  Dim Obj_FSO, Obj_dossier
  Var_rep = ""
  Var_fich = ""

  On Error Resume Next

  ' Créer une instance du FSO (Objet système de fichiers)
  Set Obj_FSO = CreateObject("Scripting.FileSystemObject")
  Set Obj_dossier = Obj_FSO.GetFolder(Var_chemin)

  Var_nb_rep = Obj_dossier.SubFolders.Count
  ReDim Var_liste_rep(Var_nb_rep)
  Var_compteur1 = 1
  'Créer la liste des répertoires du lecteur sélectionné
  For Each Var_rep In Obj_dossier.SubFolders
    'Affecter des noms de répertoire en majuscules (Ucase) pour un tri futur
    Var_liste_rep(Var_compteur1) = UCase(Var_rep.Name)
    Var_compteur1 = Var_compteur1 + 1
  Next

  'Faire appel au sous-programme de tri croissant d'une liste
  Var_liste_triee = Prog_tri_croissant(Var_liste_rep)

  For Var_compteur = 1 To Var_nb_rep
    ListBox1.AddItem Var_liste_triee(Var_compteur)
  Next Var_compteur
  
  ' Ajouter la racine (..) en premier dans la liste des répertoires
  ' seulement dans le cas où on est au niveau inférieur d'un lecteur
  ' (Exemple "C:\" fait 3 caractères)
  If Len(Var_chemin) > 3 Then
    'Ajouter le ".." en tête de liste
    ListBox1.AddItem "..", 0
  End If
  
  Var_compteur = 1
  Var_nb_fich = Obj_dossier.Files.Count
  ReDim Var_liste_fich(Var_nb_fich)
  'Créer la liste des fichiers du repertoire sélectionné
  For Each Var_fich In Obj_dossier.Files
'Réactiver la condition If suivante si vous ne voulez voir que les fichiers DWG
'    If Right(Var_fich.Name, 4) = ".dwg" Or Right(Var_fich.Name, 4) = ".DWG" Then
      'Affecter des noms de fichiers en majuscules (Ucase) pour un tri futur
      Var_liste_fich(Var_compteur) = UCase(Var_fich.Name)
      Var_compteur = Var_compteur + 1
'    End If
  Next
  
  'Redimensionner le tableau (composé d'un nombre d'éléments correspondant
  'au nombre total des fichiers du répertoire) par un nombre d'éléments
  'correspondant au nombre de fichiers ".dwg" du répertoire
  'Fonction ne supprimant que les valeurs supérieures de la différence des 2 nb d'éléments
  ReDim Preserve Var_liste_fich(Var_compteur - 1)
  
  'Faire appel au sous-programme de tri croissant d'une liste
  Var_liste_triee = Prog_tri_croissant(Var_liste_fich)

  For Var_compteur = 1 To Var_nb_fich
    ListBox2.AddItem Var_liste_triee(Var_compteur)
  Next Var_compteur
  
  ' Libérer les objets
  Set Obj_FSO = Nothing
  Set Obj_dossier = Nothing
  
End Sub

Sub Prog_recherche_lecteurs()

  Dim Obj_FSO

  On Error Resume Next

  ' Créer une instance du FSO (Objet système de fichiers)
  Set Obj_FSO = CreateObject("Scripting.FileSystemObject")

  For Each drvValue In Obj_FSO.Drives
    'Ne pas tenir compte du lecteur A
    If drvValue.DriveLetter <> "A" Then
      'Regarder si le lecteur est disponible
      If drvValue.Isready Then
        'Le lecteur est disponible :
        'Ajouter son nom dans la liste de ComboBox1 avec :\ au bout du nom
        ComboBox1.AddItem drvValue.DriveLetter & ":\"
      End If
    End If
  Next

  ' Libérer les objets
  Set Obj_FSO = Nothing

End Sub

'Liste déroulante des lecteurs
Private Sub ComboBox1_Change()
  TextBox1.Value = ComboBox1.Value
  'Effacer le contenu de la liste de répetoires
  ListBox1.Clear
  'Effacer le contenu de la liste des fichiers
  ListBox2.Clear
  Call Prog_affichage_rep_et_fichier
End Sub

'Liste des répertoires
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  On Error GoTo Error
  If ListBox1.Value = ".." Then
    'Si choix de l'utilisateur de ".."
    Dim Var_boucle As Integer
    Dim Var_position_barre As Integer
    For Var_boucle = 3 To Len(TextBox1.Value)
      'Si on détecte le dernier "\" dans la chaine de caractères : sortir de la boucle
      'de manière à ne garder en mémoire que la position de l'avant-dernière "\"
      If InStr(Var_boucle, TextBox1.Value, "\") = Len(TextBox1.Value) Then Exit For
      Var_position_barre = InStr(Var_boucle, TextBox1.Value, "\")
    Next Var_boucle
      'Supprimer le dernier sous-répertoire pour remonter d'un niveau
      TextBox1.Value = Left(TextBox1.Value, Var_position_barre)
  Else
    'Sinon ajouter le choix du nouveau sous-répertoire
    TextBox1.Value = TextBox1.Value & ListBox1.Value & "\"
  End If
  ListBox1.Clear
  ListBox2.Clear
  Call Prog_affichage_rep_et_fichier
  'Se placer tout en haut de la liste
  ListBox1.TopIndex = 0
  'Déselectionner une sélection unique dans une liste Box dont Multiselect est sur 0
  ListBox1.ListIndex = -1
Error:
End Sub

Private Sub UserForm_Activate()
  'A l'activation du programme, lancer la recherche des lecteurs.
  Call Prog_recherche_lecteurs
End Sub

Conclusion :


Ce code à été développé en VBA pour Autocad. Il utilise le Scripting Runtime (Objet système de fichiers).
Voici les différents difficultés rencontrés pour réaliser ce programme :
Commandes disponibles avec Visual Basic mais pas avec VBA (Visual Basic Application)
a-) Affichage des lecteurs avec des commandes VBScript (DriveListBox sur Visual Basic)
b-) Affichage des répertoire avec commandes VBScript (DirListBox sous Visual Basic)
c-) Affichage des fichiers avec commandes VBScript (FileListBox sous Visual Basic)
d-) Affichage des listes dans l'ordre alphabétique avec le sous programme
Prog_tri_croissant (ListViewCtl.sorted = True sous Visual Basic)
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
266
Date d'inscription
mardi 7 septembre 2004
Statut
Membre
Dernière intervention
30 avril 2009
 1
Tu m'as pris pour ton pote ou koi???
je te permets pas te me juger, reste en à tes remarques concernant le code!!!
Signaler
Messages postés
1
Date d'inscription
vendredi 2 juillet 2004
Statut
Membre
Dernière intervention
22 août 2007
En tout cas ton code m'a super bien aidé. Je n'ai pas toujours le temps de me plonger dans les recherches et là ça fonctionne tout de suite.
J'ai quand même fait qq modifs pour la forme et obtimiser le nombre de variables.
Bref, merci

Zavier666 n'a pas l'air trés intelligent comme garçon!! La critique est facile !!
Signaler
Messages postés
266
Date d'inscription
mardi 7 septembre 2004
Statut
Membre
Dernière intervention
30 avril 2009
 1
A peu de chose près, ce que je t'ai écris pour ton précédent code:

A quelques modifs près, ce code n'est ni puls ni moins qu'une retranscirption de l'aide dispo pour VBA !!???!!!!!


stls!
_______________________________________________
Toujours plus de VB6 et d'APi => API @ la loupe
http://xav.prog.power.fr
Signaler
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
 13
Re Salut,
Déjà ton code est bien lisible...cool!
8/10
A+
Exploreur
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_The Mailman)