Exploredossier : afficher les fichiers dans un dossier, et éventuellement ses sous-dossiers
Description
Analyse des sous-dossiers au choix.
Utile pour avoir une liste rapide des fichiers d'un dossier. Perso, je m'en sert souvent.
Utile pour avoir une liste rapide des fichiers d'un dossier. Perso, je m'en sert souvent.
Source / Exemple :
Dim Dossier_choisi As String
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Sub ecrire(A_ecrire As String, Optional Gras As Boolean, Optional Couleur As Long)
Etat.SelStart = Len(Etat)
Etat.SelBold = Gras
If Not (IsMissing(Couleur)) Then
Etat.SelColor = Couleur
Else
Etat.SelColor = vbBlack
End If
Etat.SelText = A_ecrire & vbNewLine
Etat.SelBold = False
Etat.SelColor = vbBlack
End Sub
Public Function explorer(ByVal Chemin As String)
On Error Resume Next
Dim id_1 As Integer
Dim id_2 As Integer
Dim id_3 As Integer
Dim ids() As String
Dim dossier_courant As String
If Dir(Chemin, vbDirectory) = "" Then
Exit Function
End If
dossier_courant = Dir(Chemin, vbDirectory)
Do While dossier_courant <> ""
If dossier_courant <> "." And dossier_courant <> ".." Then
If (GetAttr(Chemin & dossier_courant) And vbDirectory) <> 0 Then
id_1 = id_1 + 1
End If
End If
dossier_courant = Dir
Loop
ReDim ids(id_1)
dossier_courant = Dir(Chemin, vbDirectory)
Do While dossier_courant <> ""
If dossier_courant <> "." And dossier_courant <> ".." Then
If (GetAttr(Chemin & dossier_courant) And vbDirectory) <> 0 Then
id_2 = id_2 + 1
ids(id_2) = dossier_courant
If Afficher_sous_dossiers.Value <> 0 Then
ecrire dossier_courant, True
End If
Else
ecrire dossier_courant
End If
End If
dossier_courant = Dir
Loop
For id_3 = 1 To id_1
If Sous_dossiers.Value <> 0 Then
explorer Chemin & ids(id_3) & "\"
End If
Next
End Function
Private Sub Parcourir_Click()
Dim Rien As Integer
Dim Liste As Long
Dim Resultat As String
Dim Browse_info As BrowseInfo
With Browse_info
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat("Choix du dossier à analyser", "")
.ulFlags = 1
End With
Liste = SHBrowseForFolder(Browse_info)
If Liste Then
Resultat = String$(260, 0)
SHGetPathFromIDList Liste, Resultat
CoTaskMemFree Liste
Rien = InStr(Resultat, vbNullChar)
If Rien Then
Dossier_choisi = Left$(Resultat, Rien - 1)
MsgBox "Le dossier choisi est :" & vbNewLine & Dossier_choisi, vbInformation
End If
End If
End Sub
Private Sub Parti_Click()
If Dossier_choisi = "" Then
MsgBox "Vous devez sélectionner un dossier à analyser.", vbExclamation
Exit Sub
End If
If Right(Dossier_choisi, 1) <> "\" Then
Dossier_choisi = Dossier_choisi & "\"
End If
Parcourir.Enabled = False
Sous_dossiers.Enabled = False
Afficher_sous_dossiers.Enabled = False
Parti.Enabled = False
Etat.Text = ""
ecrire "C'est parti dans " & Dossier_choisi, True, vbBlue
explorer Dossier_choisi
ecrire "C'est fini !", True, vbBlue
Parcourir.Enabled = True
Sous_dossiers.Enabled = True
Afficher_sous_dossiers.Enabled = True
Parti.Enabled = True
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.