Soyez le premier à donner votre avis sur cette source.
Vue 6 551 fois - Téléchargée 779 fois
Option Explicit Sub Initialise_TreeDir(TreeDir As TreeView) Dim ExpDr, Rep, Drv, S As String, N, D, a, r, Unite Dim Cle As String, sCle As String, Num As Integer, Sr As Integer Dim nodX As Node Num = 64 Set ExpDr = CreateObject("Scripting.FileSystemObject") Set Drv = ExpDr.Drives For Each D In Drv S = D.DriveLetter '& ":" If D.DriveType = 3 Then 'réseaux N = D.ShareName ElseIf D.DriveType = 1 Then 'DD externe N = " - Média amovible - (" & D.VolumeName & ")" Incr Num: Cle = S S = S & ":\" Set nodX = TreeDir.Nodes.Add(, , Cle, S & N, 6) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 2 Then 'DD N = D.VolumeName Incr Num: Cle = S S = S & ":\" Set nodX = TreeDir.Nodes.Add(, , Cle, S & " - (" & N & ")", 2) AjoutRep S, Cle, TreeDir ElseIf D.DriveType = 4 Then 'DVD On Error Resume Next N = D.VolumeName If Err = 71 Then N = "Lecteur DVD - (vide) " Else N = "Lecteur DVD - (" & N & ")" End If Incr Num: Cle = Chr(Num) & "0" S = S & ":\ - " Set nodX = TreeDir.Nodes.Add(, , Cle, S & N, 3) Else Stop End If S = "" D = "" Next Set nodX = Nothing Set ExpDr = Nothing Set Drv = Nothing End Sub Sub AjoutRep(Chem As String, Cle As String, TreeDir As TreeView) Dim Rep, sRp, Obj, sRep, sR2 Dim sCle As String, Num As Integer, Sr As Integer Dim nodX As Node Dim NbsR As Integer, S As String Sr = 9 Chem = Chem & IIf(Right(Chem, 1) = "\", "", "\") Set Obj = CreateObject("Scripting.FileSystemObject") Set Rep = Obj.Getfolder(Chem) If Left(Rep.Name, 1) = "$" Then GoTo Passe2 Set sRep = Rep.subfolders For Each sRp In sRep S = UCase(sRp.Name) If Left(S, 1) = "$" Or S = "WINDOWS" Or sRp.Attributes > 100 Or sRp.Attributes = 19 _ Or Left(S, 6) = "SYSTEM" Or Left(S, 7) = "PROGRAM" Or Left(S, 4) = "USER" _ Or Left(S, 6) = "DRIVER" Or Left(S, 5) = "TOOLS" Then GoTo Passe On Error Resume Next Set sR2 = sRp.subfolders NbsR = sR2.Count If Err <> 0 Then Err = 0: GoTo Passe Incr Sr sCle = sRp.Path & "\" On Error GoTo 0 'Debug.Print sRp.Name; " "; Cle; " "; sCle Set nodX = TreeDir.Nodes.Add(Cle, tvwChild, sCle, sRp.Name, 5, 4) If NbsR > 0 Then AjoutRep sRp.Path, sCle, TreeDir End If Passe: Next Passe2: Set Obj = Nothing Set Rep = Nothing Set sRep = Nothing Set nodX = Nothing Set sR2 = Nothing End Sub
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.