IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VB 6 et antérieur Discussion :

[VB]Recherche récursive...


Sujet :

VB 6 et antérieur

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut [VB]Recherche récursive...
    Bonjour,
    j'aimerais trouver le moyen de faire une recherche de fichiers sur une partition, donc dans une arborescence. J'ai chercher sur ce forum pour finallement apprendre que dir() n'est pas une solution. J'ai aussi trouvé un post qui donne une technique de recherche mais c'est du vba et non du vb et même en supprimant la première ligne, comme expliqué dans le post, je concerve des messages d'erreur... Quelqu'un aurait un bout de code pour moi???

  2. #2
    Membre Expert Avatar de Megaxel
    Profil pro
    Inscrit en
    Mai 2003
    Messages
    1 187
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mai 2003
    Messages : 1 187
    Par défaut
    Hello!
    C'est quoi, cette solution VB mais pas VBA qui ne marche pas même en supprimant une mystérieuse dernière ligne?
    Montre nous ce code, on va voir si on peut en faire quelquechose.
    Il utilise le FSO?

  3. #3
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    Heu, c'est un fait, j'ai pas réfléchis sur ce coup-là...

    salut, voici ma fonction pour une recherche de fichier

    biensur, il faut l'adapter pour ton projet


    Dans un module:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
     
    Option Compare Database 
    Option Explicit 
     
    Public AnnulerRech As Boolean 
     
    '---------------------------------------- 
    '------Déclarations propres aux API------ 
    '---------------------------------------- 
    '---Les constantes--- 
    Public Const MAX_PATH = 260 
    Public Const INVALID_HANDLE_VALUE = -1 
    Public Const FILE_ATTRIBUTE_READONLY = &H1 
    Public Const FILE_ATTRIBUTE_HIDDEN = &H2 
    Public Const FILE_ATTRIBUTE_SYSTEM = &H4 
    Public Const FILE_ATTRIBUTE_DIRECTORY = &H10 
    Public Const FILE_ATTRIBUTE_ARCHIVE = &H20 
    Public Const FILE_ATTRIBUTE_NORMAL = &H80 
    Public Const FILE_ATTRIBUTE_TEMPORARY = &H100 
    Public Const FILE_ATTRIBUTE_COMPRESSED = &H800 
     
    '---Les API--- 
    Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _ 
             (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long 
    Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _ 
             (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long 
    Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long 
     
    '---Les types--- 
    Public Type FILETIME 
        dwLowDateTime As Long 
        dwHighDateTime As Long 
    End Type 
     
    Public Type WIN32_FIND_DATA 
        dwFileAttributes As Long 
        ftCreationTime As FILETIME 
        ftLastAccessTime As FILETIME 
        ftLastWriteTime As FILETIME 
        nFileSizeHigh As Long 
        nFileSizeLow As Long 
        dwReserved0 As Long 
        dwReserved1 As Long 
        cFileName As String * MAX_PATH 
        cAlternate As String * 14 
    End Type 
     
    '---------------------------------------------- 
    '------Déclarations propres à la fonction------ 
    '---------------------------------------------- 
    Public Type ListeFichier 
        Fichiers() As WIN32_FIND_DATA 
        Chemin() As String * MAX_PATH 
        Nombre As Long 
    End Type 
     
    '-------------------------------------------------------- 
    '---La fonction Rechercher : --- 
    '--- Cette fonction recherche tous les fichiers dans --- 
    '--- le répertoire spécifié et ses sous-repertoires --- 
    '--- Elle retourne le nombre d'occurences trouvées --- 
    '--- Elle commence par rechercher tous les dossier --- 
    '--- ensuite elle fait une recherche pour des sous-dossier --- 
    '--- si sous-dossier trouvé, alors recommence la recherche de fichier --- 
    '-------------------------------------------------------- 
    Public Function Rechercher(Chemin As String, FichierR As String, _ 
            ResultatRecherche As ListeFichier) As Long 
    '---Déclaration des variables--- 
    Dim lpFindFileData As WIN32_FIND_DATA 
    Dim hFindFile As Long 
    Dim lgRep As Long 
    Dim CheminRep As String 
    '---Recherche tous les fichiers demandés dans le répertoire Chemin--- 
    hFindFile = FindFirstFile(Chemin & FichierR, lpFindFileData) 
    If hFindFile <> INVALID_HANDLE_VALUE Then 
    '############### 
    'ICI ON RECHERCHE TOUS LES FICHIER QUI PORTE LE NOM DE FichierR 
    'IL NE CHERCHE QUE CE FICHIER LA, ALORS IL SAUTE TOUS LES AUTRES 
    '############### 
        Do 
            ' Mémorise 
            ResultatRecherche.Nombre = ResultatRecherche.Nombre + 1 'AUGEMENTE LE NOMBRE DE FICHIER TROUVÉ DE 1 
            ReDim Preserve ResultatRecherche.Chemin(1 To ResultatRecherche.Nombre) 'REDIMENSIONNE LE TABLEAU AVEC LA NOUVELLE TAILLE 
            ReDim Preserve ResultatRecherche.Fichiers(1 To ResultatRecherche.Nombre) 'REDIMENSIONNE LE TABLEAU AVEC LA NOUVELLE TAILLE 
            ResultatRecherche.Chemin(ResultatRecherche.Nombre) = Chemin 'MÉMORISE LE CHEMIN DU FICHIER TROUVÉ 
            ResultatRecherche.Fichiers(ResultatRecherche.Nombre) = lpFindFileData 'MÉMORISE LE NOM DU FICHIER TROUVÉ 
            ' Initialise lpFindFileData (Variable texte uniquement) 
            lpFindFileData.cAlternate = String$(14, 0) 
            lpFindFileData.cFileName = String$(MAX_PATH, 0) 
            DoEvents 
        'BOUCLE TANT QU'IL RESTE DES FICHIER OU QUE LA VARIABLE ANNULERRECH = TRUE 
        Loop Until FindNextFile(hFindFile, lpFindFileData) = 0 Or AnnulerRech = True 
    End If 
    FindClose hFindFile 'FERME L'INSTANCE 
    '---Recherche dans les sous-répertoires--- 
    '############### 
    'ICI ON CHERCHE TOUT LES FICHIER\DOSSIER QUI CONTIENT UN . 
    '############### 
    hFindFile = FindFirstFile(Chemin & "*.*", lpFindFileData) 
    If (hFindFile <> INVALID_HANDLE_VALUE) Then 
        Do 
            ' Si c'est un répertoire on continu la recherche 
            'LA RECHERCHE DES FICHIERS EST EFFECTUÉ PLUS HAUT, ALORS  CE QU'ON CHERCHE C'EST SEULEMENT LES RÉPERTOIRE      
            If (lpFindFileData.dwFileAttributes And _ 
                FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then 'C'EST UN RÉPERTOIRE, ALORS IL FAUT  VÉFIFIER QUE LE RÉPERTOIRE N'EST PAS LE . OU .. 
                ' Extraction du nom du répertoire 
                CheminRep = Mid$(lpFindFileData.cFileName, 1, _ 
                            InStr(1, lpFindFileData.cFileName, Chr$(0)) - 1) 
                ' Attention dans les sous-répertoire aux 
                ' répertoires . et .. (Retour répertoire parent) 
     
                'VÉRIFICATION DU RÉPERTOIRE 
                If (CheminRep <> ".") And (CheminRep <> "..") Then 
                    'LE RÉPERTOIRE N'EST PAS . OU .. 
                    CheminRep = Chemin & CheminRep & "\" 'MÉMORISE LE NOM DU RÉPERTOIRE DANS UNE VARIABLE 
     
                    SysCmd acSysCmdSetStatus, "Dossier: " & CheminRep 
                    Rechercher = Rechercher(CheminRep, FichierR, ResultatRecherche) 'RELANCE LA FONCTION RECHERCHER DANS LE SOUS-RÉPERTOIRE 
                End If 
            End If 
            DoEvents 
        'TANT QU'IL Y A DES FICHIER\DOSSIER ET ANNULERRECH = TRUE 
        Loop Until FindNextFile(hFindFile, lpFindFileData) = 0 Or AnnulerRech = True 
    End If 
    FindClose hFindFile 'FERME L'INSTANCE 
    SysCmd acSysCmdClearStatus 
    '---Retourne le nombre d'occurrences trouvées--- 
    Rechercher = ResultatRecherche.Nombre 'RETOURNE LE NB D'OCCURENCE 
    End Function

    Procédure qui appel la fonction rechercher:
    Code:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    Private Sub BtnLancerRech_Click() 
     
     
    If ((Not IsNull(edtPath.Value)) And (edtPath.Value <> "")) Then 
        btnFocus.SetFocus 
        BtnRech.Visible = False 
        BtnLancerRech.Visible = False 
        BtnAnnulerRech.Visible = True 
     
        Dim ResultatRecherche As ListeFichier 
        Dim NombreOccurence As Long 
        Dim I As Integer 
        Dim r As Variant 
     
        '---Recherche de tous les fichiers 
        lstPath.RowSource = "Résultat de la recherche;" 
        AnnulerRech = False 'variable public pour annuler la recherche (true = annuler) 
        SysCmd acSysCmdSetStatus, " " 
        Select Case MainOptionBD.Value 
            Case 1: NombreOccurence = Rechercher(edtPath.Value, BDGift, ResultatRecherche) 
            Case 2: NombreOccurence = Rechercher(edtPath.Value, BDCorporatif, ResultatRecherche) 
            Case 3: NombreOccurence = Rechercher(edtPath.Value, BDDeveloppement, ResultatRecherche) 
            Case 4: NombreOccurence = Rechercher(edtPath.Value, BDCorporatif_Developement, ResultatRecherche) 
            Case 5: NombreOccurence = Rechercher(edtPath.Value, BDGOD, ResultatRecherche) 
        End Select 
        ' Toutes les informations de la recherche sont dans la variables ResultatRecherche 
        For I = 1 To NombreOccurence 
            lstPath.RowSource = lstPath.RowSource & Trim$(ResultatRecherche.Chemin(I)) & Trim$(ResultatRecherche.Fichiers(I).cFileName) 
            lstPath.RowSource = lstPath.RowSource & ";" 
        Next 
        BtnRech.Visible = True 
        BtnLancerRech.Visible = True 
        BtnAnnulerRech.Visible = False 
        Else: MsgBox "Veuillez sélectionner un chemin pour la recherche.", vbInformation, "Information" 
    End If 
    End Sub
    La ligne à retirer est la première d'après le post (Option Compare Database) Mais chez moi, ça passe tojours pas...

  4. #4
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Punaise ! Je préfère VBA !

    With Application
    MsgBox Workbooks("Classeur5.xls").path
    End With

  5. #5
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    Et moi, le java... Mais pas le choix du langage...

  6. #6
    Membre confirmé
    Inscrit en
    Décembre 2004
    Messages
    25
    Détails du profil
    Informations forums :
    Inscription : Décembre 2004
    Messages : 25
    Par défaut
    salut!
    le cd-rom de msdn contient la solution au pb de recherche de fichier dans tout l'ordi. il suffit de parcourir les démos vb qu'il contient.

  7. #7
    Expert confirmé
    Avatar de ThierryAIM
    Homme Profil pro
    Inscrit en
    Septembre 2002
    Messages
    3 673
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : France, Rhône (Rhône Alpes)

    Informations professionnelles :
    Secteur : Industrie

    Informations forums :
    Inscription : Septembre 2002
    Messages : 3 673
    Par défaut
    Ca ne fait pas ce que tu veux, ça :
    http://vb.developpez.com/sources/?pa...onF#scanfolder

  8. #8
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    C'est génial, la solution fonctionne, je n'ai plus qu'à l'adpter un minimum... Merci...
    Au passage, est-ce que l'un de vous sait comment marquer une pause dans une exécution??? Genre l'exécution du prog s'interromp pendant 5 seconde...

  9. #9
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Tu as sleep :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Sub pause()
        Sleep 5000 'en millisecondes
    End sub
    Aimablement offert par DarkVader mais il te dirait certainement qu'il y a mieux ou plus adapté.

    A+

  10. #10
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    C'est génial... Merci beaucoup...

  11. #11
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    J'avais testé le programme que Thierry AIM m'a proposé avec un nom de fichier bien précis, ça a fonctionné, parcontre, lorsque j'essaie avec *.txt par exemple, ça ne ressort strictement rien... Comment celà se fait-il???

  12. #12
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    Voici la fonction de recherche qui ma fois, me semble très courte...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Public Function ScanFolder(FolderPath As String, Optional Filename As String = "", Optional SubFold As Boolean = True) As Long
    ' Fonction récursive pour l'exploration des répertoires
     
        Dim Element As Variant
        Dim StrPath() As String
     
        ScanFolder = fs.GetFolder(FolderPath).Files.Count
     
        For Each Element In fs.GetFolder(FolderPath).Files
            Form1.StatusBar1.Panels(1).Text = FolderPath
            If Filename <> "" Then
                StrPath = Split(Element, "\")
                If InStr(1, StrPath(UBound(StrPath)), Filename) Then _
                        Form1.List1.AddItem Element
            Else
                Form1.List1.AddItem Element
            End If
            DoEvents
        Next Element
     
        If SubFold Then
            For Each Element In fs.GetFolder(FolderPath).SubFolders
                ScanFolder = ScanFolder + ScanFolder(Element.Path, Filename, SubFold)
            Next Element
        End If
    End Function

  13. #13
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    Je présume que l'endroit où ça cloche est le moment de la comparaison mais quoi y mettre???

  14. #14
    Membre éclairé Avatar de Empty_body
    Profil pro
    Inscrit en
    Mai 2004
    Messages
    681
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : Mai 2004
    Messages : 681
    Par défaut
    En regardant le code plus attetivement, j'ai trouvé mon erreur... La fonction utilisée est instr, l'étoile devenait donc un caractère superflux qui me mettait tout en pièce...

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Recherche récursive de fichier
    Par maxshell dans le forum x86 32-bits / 64-bits
    Réponses: 0
    Dernier message: 31/07/2009, 11h15
  2. Recherche récursive de fichiers
    Par atm0sfe4r dans le forum wxWidgets
    Réponses: 2
    Dernier message: 22/04/2009, 10h54
  3. Recherche récursive avec TIdFTP
    Par Leucistic dans le forum Débuter
    Réponses: 6
    Dernier message: 21/04/2008, 17h00
  4. Recherches récursives sur une table unique
    Par Selenn dans le forum Langage SQL
    Réponses: 15
    Dernier message: 01/02/2008, 13h20
  5. Probleme de recherche récursive de fichiers
    Par JbTech dans le forum VB.NET
    Réponses: 5
    Dernier message: 30/07/2007, 14h02

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo