Explorateur de fichiers vba (le drive+dir+filelistbox du vb)
Soyez le premier à donner votre avis sur cette source.
Vue 18 930 fois - Téléchargée 1 098 fois
Description
L'objectif de ce code est d'afficher les fichiers sous la forme d'un explorateur.
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)
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)
Codes Sources
A voir également
- Dir visual basic
- Vba explorateur de fichier - Forum - Visual Basic
- [déplacé VB6 -> VBA] comment ouvrir un explorateur de fichier ✓ - Forum - Visual Basic 6
- [déplacé VB.NET -> VBA] Ouvrir un explorateur de fichier à partir d'un formulair ✓ - Forum - Visual Basic 6
- Vba ouvrir explorateur de fichier ✓ - Forum - Visual Basic 6
- Pouvoir ouvrir des fichiers excel avec vba sans le faire planter ✓ - Forum - Visual Basic 6
Commentaires
je te permets pas te me juger, reste en à tes remarques concernant le code!!!
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 !!
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
- Messages postés
-
4822
- Date d'inscription
- lundi 11 novembre 2002
- Statut
- Membre
- Dernière intervention
- 15 novembre 2016
12Déjà ton code est bien lisible...cool!
8/10
A+
Exploreur
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.