Recherche dans Dossier et sous dossier [Résolu]

Signaler
Messages postés
54
Date d'inscription
mercredi 8 décembre 2004
Statut
Membre
Dernière intervention
13 janvier 2006
-
Messages postés
54
Date d'inscription
mercredi 8 décembre 2004
Statut
Membre
Dernière intervention
13 janvier 2006
-
Bijour,
Je développe actuellement une appli et je souhaiterais que l'utilisateur puisse sélectionner un dossier et ensuite recherche tous les dossiers d'un certain type (ex : "*.doc") ou en recherchant un mot dans tous les fichiers et sous-dossiers.
En gros, cela ressemble à ce que l'on peut trouver sous windows en faisant rechercher (ou ctrl + F).

Je remercie les bonnes âmes m'aidant dans ma recherche.

3 réponses

Messages postés
19
Date d'inscription
mercredi 30 juillet 2003
Statut
Membre
Dernière intervention
21 juin 2011

Voici un code interessant :

Corp du programme:

'Choix du répertoire de départ
strFolderStart = funcFolderStart()

'Recherche des fichiers et sous répertoires
subFolderFileScan strFolderStart

Fonction:
'***************************************************************************************
' Project : Link
'***************************************************************************************
' Module : FolderStart
' DateTime : 25/05/2005 11:07
' Author : FFH173
' Purpose : Selection du répertoire de départ
'***************************************************************************************


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


Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260


Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (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


'---------------------------------------------------------------------------------------
' Procedure : funcFolderStart
' DateTime : 24/05/2005 16:26
' Author : FFH173
' Purpose : Selection du répertoire de départ
'---------------------------------------------------------------------------------------


Public Function funcFolderStart() As String


Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim strPath As String
Dim udtBI As BrowseInfo

On Error GoTo funcFolderStart_Error


With udtBI
'Set the owner window
.hWndOwner = frmMain.hWnd
'lstrcat appends the two strings and returns the memory address
.lpszTitle = lstrcat("C:", "")
'Return only if the user selected a directory
.ulFlags = BIF_RETURNONLYFSDIRS
End With


'Show the 'Browse for folder' dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
strPath = String$(MAX_PATH, 0)
'Get the path from the IDList
SHGetPathFromIDList lpIDList, strPath
'Free the block of memory
CoTaskMemFree lpIDList
iNull = InStr(strPath, vbNullChar)
If iNull Then
strPath = Left$(strPath, iNull - 1)
End If
End If


funcFolderStart = strPath


funcFolderStart_Exit:


On Error GoTo 0


Exit Function


funcFolderStart_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure funcFolderStart of Module frmMain"
Resume funcFolderStart_Exit


End Function

'***************************************************************************************
' Project : Link
'***************************************************************************************
' Module : FolderFileScan
' DateTime : 25/05/2005 13:06
' Author : FFH173
' Purpose : Recherche des fichiers et sous-répertoires dans un répertoire de départ
'***************************************************************************************


Option Explicit


Dim FSO As New FileSystemObject


'---------------------------------------------------------------------------------------
' Procedure : funcFolderFileScan
' DateTime : 25/05/2005 13:07
' Author : FFH173
' Purpose : Recherche des fichiers et sous-répertoires dans un répertoire de départ
'---------------------------------------------------------------------------------------


Sub subFolderFileScan(Path As String)


Dim Folder As Folder
Dim File As File


On Error GoTo subFolderFileScan_Error


'Transformation du string en nom de folder
Set Folder = FSO.GetFolder(Path)

'Liste de tous les fichiers dans un répertoire
For Each File In Folder.Files
Select Case Right(File.Name, 3)
Case "doc", "xls", "ppt", "pfd", "mdb"
funcLinkScan Folder.Path, File.Name, 1, FreeFile
Case "xls"
funcLinkScan Folder.Path, File.Name, 2, FreeFile
Case "ppt"
funcLinkScan Folder.Path, File.Name, 3, FreeFile
Case "pfd"
funcLinkScan Folder.Path, File.Name, 4, FreeFile
Case "mdb"
funcLinkScan Folder.Path, File.Name, 5, FreeFile
End Select
Next File

'Liste de tous les sous-répertoires dans un répertoire et
'récursivité de la procédure pour la recherche sur le niveau suivant
For Each Folder In FSO.GetFolder(Path).SubFolders
subFolderFileScan Folder.Path
Next Folder


subFolderFileScan_Exit:


On Error GoTo 0


Exit Sub


subFolderFileScan_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure subFolderFileScan of Module FolderFileScan"
Resume subFolderFileScan_Exit


End Sub

DPhBxl
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 123 internautes nous ont dit merci ce mois-ci

Messages postés
51
Date d'inscription
lundi 12 mai 2003
Statut
Membre
Dernière intervention
8 février 2011

Essaye la source http://www.vbfrance.com/code.aspx?ID=4928.

( y'a tous et c'est très rapide).
Messages postés
54
Date d'inscription
mercredi 8 décembre 2004
Statut
Membre
Dernière intervention
13 janvier 2006

Merci à vous 2.

Ca marche !

@+++ bonne prog