Explorateur de fichiers sous access

Soyez le premier à donner votre avis sur cette source.

Vue 10 962 fois - Téléchargée 1 001 fois

Description

Comme le titre l'indique, c'est un explorateur de fichiers sous access gérer par un treeview, un listview et une imageList. Ce programme permet de visualiser l'arborescence des fichiers de vos disques ainsi que de les lancer grâce à la lib ShellExecuteA.
Je n'ai pas intégré les lecteurs réseaux car si vous n'avez pas accès à certains répertoires, il y a une erreur qui se produit. Si vous êtes administrateur du réseau, vous n'avez qu'à enlever le "if (d.DriteType <> 3)" ... pour pouvoir les voir.

Source / Exemple :


Option Compare Database
Dim LV1Path, rep, fic, FicOld As String
Dim Same As Boolean
Dim Ind As Integer

Private Sub Form_Load()
    Dim fs As Object
    Dim dc, d
    Dim str, n, img As String

    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dc = fs.Drives
    For Each d In dc
        If (d.IsReady) Then
            str = fs.GetDrive(d.Driveletter).RootFolder
        Else:
            GoTo suite2
        End If
        Select Case d.DriveType
            Case 0: n = "Inconnu"
            Case 1: n = "Amovible"
            Case 2:
                n = d.VolumeName
                img = "HDD"
            Case 3:
                n = d.ShareName
                img = "DR"
            Case 4:
                n = "CD-ROM"
                img = "CD"
            Case 5: n = "Disque RAM"
        End Select

        n = n & " (" & d.Driveletter & ":)"
        'Création des noeuds racines des disques)
        If (d.DriveType <> 3) Then
            Me.TV1.Nodes.Add , , str, n, img
            AjouteRep str
        End If
suite2:
    Next
End Sub

Private Sub AjouteRep(ByVal str As String, Optional ByRef Node As Object = Nothing)
    Dim fs, f, fld, fld1, sf
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(str)
    Set sf = f.SubFolders
    For Each fld In sf
        'Évite les répertoire qui font planter la fonction
        If fld.Name = "RECYCLER" Then GoTo suite
        If fld.Name = "System Volume Information" Then GoTo suite
        If fld.Name = "DO_NOT_REMOVE_NtFrs_PreInstall_Directory" Then GoTo suite
        'ajoute les dossier
        If f.IsRootFolder = True Then
            Me.TV1.Nodes.Add str, tvwChild, fld.Path, fld.Name, "Dossier"
            'Ajoute les sous dossiers
            AjouteRep fld.Path
         Else:
            Me.TV1.Nodes.Add str, tvwChild, fld.Path, fld.Name, "Dossier"
            AjouteRep fld.Path
         End If
suite:
    Next
End Sub

'Gestion des clics dans le TreeView
Private Sub TV1_NodeClick(ByVal Node As Object)
    Dim li As ListItem
    Dim li2 As ListItem
    Dim fld
    Dim fic, rep, img As String
    Dim f
    Dim fldl
    Dim message As Boolean 'sera utile pour filtrer des dossiers à ne pas afficher
    Dim fs As Object
    Dim a As Integer
    
    a = 2
    Ind = Node.Index
    Me.LV1.ListItems.Clear
    'construit le nom du répertoire
    While (Mid(Node.FullPath, a, 1) <> ":")
        a = a + 1
    Wend
    rep = Mid(Node.FullPath, a - 1, 2) & Mid(Node.FullPath, a + 2)
    'MsgBox rep
    If Right(rep, 1) <> "\" Then rep = rep & "\"
    LV1Path = rep
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fld = fs.GetFolder(rep)
    message = False
    
    'ajoute les éléments dossier a LV1 sans prendre en compte la poubelle et l'information de volume systeme.
    For Each fldl In fld.SubFolders
        If fldl.Name = "RECYCLER" Then message = True
        If fldl.Name = "System Volume Information" Then message = True
        'MsgBox fldl.Name
        If message = False Then
           Me.LV1.ListItems.Add , , fldl.Name, "Dossier", "Dossier"
            'li.ListSubItems.Add Key:="size", Text:=fldl.Size
            'li.ListSubItems.Add Key:="date", Text:=fldl.DateLastModified
        End If
    Next
    
    'ajouter les élément fichier a LV1
    For Each f In fld.Files
        'On affecte l'image en fonction du type du fichier
        img = FindImg(f.Name)
        Me.LV1.ListItems.Add , , f.Name, img, img
        'Me.LV1.ListSubItems.Add Key:="size", Text:=f.Size
        'li2.ListSubItems.Add Key:="date", Text:=f.DateLastModified
    Next
End Sub

'Gestion des clics dans la listeView
Private Sub LV1_ItemClick(ByVal Item As Object)
    Dim fs As Object
    Dim f, fldl, fld
    Dim message As Boolean

    'Construit le nom du répertoire
    GetRep Item 'donne rep, fic et LV1Path
    
    If Item.Icon <> "Dossier" Then
        MsgBox "Vous ne pouvez pas lancer les fichiers! :'("
        'If (Right(fic, 3) = "exe") Then
        '    Shell (rep), vbMaximizedFocus
        'End If
        Exit Sub 's'il ne sagit pas d'un dossier on sort de la sub
    End If
    
    'Récupération de l'index du node correspondant dans le treeview
    Ind = Me.TV1.Nodes(Ind).Child.FirstSibling.Index
    While Me.TV1.Nodes(Ind).Text <> Item.Text
          Ind = Me.TV1.Nodes(Ind).Next.Index
    Wend
    TV1_Expand (Me.TV1.Nodes(Ind))

    Me.LV1.ListItems.Clear
    
    'construit rep
    MsgBox rep
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set fld = fs.GetFolder(rep)

    message = False
    'Ajoute les éléments dossier à LV1 sans prendre en compte la poubelle et l'information du volume systeme.
    For Each fldl In fld.SubFolders
        If fldl.Name = "RECYCLER" Then message = True
        If fldl.Name = "System Volume Information" Then message = True
        If message = False Then
            Me.LV1.ListItems.Add , , fldl.Name, "Dossier", "Dossier"
            'li.ListSubItems.Add Key:="size", Text:=fldl.Size
            'li.ListSubItems.Add Key:="date", Text:=fldl.DateLastModified
        End If
    Next
    
    'Ajouter les élément fichier à LV1
    For Each f In fld.Files
        img = FindImg(f.Name)
        Me.LV1.ListItems.Add , , f.Name, img, img
        'li2.ListSubItems.Add Key:="size", Text:=f.Size
        'li2.ListSubItems.Add Key:="date", Text:=f.DateLastModified
    Next

End Sub

Public Sub TV1_Expand(ByVal Node As Object)
    If (Node.Parent Is Nothing = False) Then 'S'il s'agit des lecteurs on ne change pas l'image
        Node.Image = "DossierOpen"
    End If
End Sub

Public Sub TV1_Collapse(ByVal Node As Object)
    If (Node.Parent Is Nothing = False) Then
        Node.Image = "Dossier"
    End If
End Sub

Private Function FindImg(str As String) As String
    Select Case Right(str, 3)
            Case Is = "txt": FindImg = "Txt"
            Case Is = "doc": FindImg = "Doc"
            Case Is = "zip": FindImg = "Zip"
            Case Is = "rar": FindImg = "Zip"
            Case Is = "exe": FindImg = "Exe"
            Case Is = "mdb": FindImg = "Mdb"
            Case Is = "xls": FindImg = "Xls"
            Case Is = "ppt": FindImg = "Ppt"
            Case Is = "tml": FindImg = "IE"
            Case Is = "htm": FindImg = "IE"
            Case Is = "wav": FindImg = "Mp3"
            Case Is = "mp3": FindImg = "Mp3"
            Case Is = "dll": FindImg = "Dll"
            Case Is = "ini": FindImg = "Ini"
            Case Is = "bmp": FindImg = "Img"
            Case Is = "jpg": FindImg = "Img"
            Case Is = "gif": FindImg = "Img"
            Case Else: FindImg = "Unk"
        End Select
End Function

Public Function GetRep(ByVal Item As Object) As String
    'Construction le nom du répertoire
    fic = Item.Text 'Nom du fichier cliqué
    rep = LV1Path
    If Right(rep, 1) <> "\" Then rep = rep & "\"
    rep = rep & fic
    LV1Path = rep
End Function

Conclusion :


Pas mal si on veut voir comment marche les TV et LV, mais il est plus simple de faire un activeX en VB à partir des DirListBox & cie et de les appliquer sous access...
De plus, ça ira plus vite qu'un Treeview...

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
9
En fait ce code commence à dater...
En regardant bien, genre mon dernier message, vous verrez des commentaires disant que le plantage est souvent dû à des répertoires inaccessibles. Ce code n'est pas optimisé, il affiche TOUS les répertoires, donc si vous avez un ou plusieurs gros disque, ça risque d'être trèèèèèèèèèèèès long a afficher.
De plus, avec vista et compagnie (j'ai créer ce code sous XP), les noms des répertoires spéciaux sont différents et bcp sont interdit d'accès. Sans parler des autorisations etc. Il faut donc faire un travail de recherche pour les lister, et empêcher la fonction de passer dessus. De plus, il est préférable de commencer par des p'tits bouts de disque, préférer afficher l'arborescence d'un répertoire plutôt que d'un disque! sinon, il va passer sur tout et sous vista c'est source d'erreur assuré...
De plus, cette source est là pour le fun, elle montre comment marche un explorateur de fichiers grosso modo; pour faire ce que vous voulez, vous avez d'autres sources plus utiles telles que celle que j'ai faite sur les OCX dirlistbox pour ACCESS...
Messages postés
1
Date d'inscription
mercredi 27 janvier 2010
Statut
Membre
Dernière intervention
27 janvier 2010

Bonjour

J'essaie,dans Access2003, de faire un bouton qui ouvre cet explorateur et d'avoir au retour le chemin complet du fichier choisi dans un champ ...
Et je n'y arrive pas

=> Où coller le code exposé ci dessous ?

Merci d'avance

Jeff
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
9
Ha oui, j'oubliais, j'ai mis dans le code
If fldl.Name "RECYCLER" Then message True
If fldl.Name "System Volume Information" Then message True
Parce que la poubelle et le SVI font planter la fonction.
Si tu as vista, je pense que ces noms doivent être différent et du coup ça plante, c'est une possibilité...
A voir, si les noms sont pareils, auquel cas, les rajouter dans le code et nous les indiquer par la même occasion ;)
Messages postés
940
Date d'inscription
jeudi 20 février 2003
Statut
Membre
Dernière intervention
3 février 2011
9
Il doit sûrement essayer d'ouvrir un de tes lecteurs, sur lequel ya une erreur ou quelque chose qu'il n'arrive pas à ouvrir. Dans un 1er temps, lances le fichier .mdb en restant appuyer sur shift jusqu'à ce qu'ACCESS s'ouvre sur la base de données. Puis, vas dans le code pour mettre en commentaire la boucle qui check tous les disques (For Each d In dc)
et prends que le disque C: dans un premier temps. Ceci devrait marcher. Sinon, c'est qu'ya une erreur sur ton disque C:, essayes alors de lire un CD-ROM ou autre...
Messages postés
8
Date d'inscription
mercredi 19 mars 2008
Statut
Membre
Dernière intervention
10 juin 2009

Bonjour,
Dommage c'est vraiment ce que je recherche, mais impossible d'ouvrir la base, elle plante dès le démarage sous access2007.
J'ai recrée une autre base d'essai pu j'ai importer le frm et le module --> même résultat : plantage
Dernière manipulation, j'ai essayé d'ouvrir sur un autre micro avec Access200 , des le click sur le frm ---> plantage !

Why ?

Merci à bientôt
Alain
Afficher les 9 commentaires

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.