Recherche par mot clé

[groupes.blb]

Bonjour,

J'utilise beaucoup Excel pour prendre des notes de façon très simple avec une ligne de titre et des lignes de détail. La ligne de titre contient des mots clés. En général je les stocke sous forme d'un fichier .xls par semaine avec plusieurs onglets.

J'aimerais pouvoir développer en VBA un utilitaire pour aller rechercher rapidement dans le répertoire tous les fichiers, onglets et lignes de titre contenant un ou plusieurs mots clé. Je n'ai pas trop d'idée sur comment s'y prendre. Le mieux et peut être d'alimenter un fichier index au fur e à mesure des mises à jour ?

Si quelqu'un a déjà eu ce même type de sujet, je suis preneur de toute suggestion.

Merci d'avance.

BLB.

 

[Theze]

Re : Recherche par mot clé

Bonjour,

Un premier jet pour voir si le début te convient. Adapte le chemin du dossier à scruter ainsi que le critère de recherche dans la proc "RecupFichier" puis exécute la. Le résultat est affiché dans la fenêtre d'exécution (Ctrl + G) :

Sub RecupFichier()

    Dim Tbl() As String
    Dim TblRecup() As String
    Dim Dossier As String
    Dim Critere As String
    Dim I As Integer
    Dim J As Integer
    
    'adapter le chemin
    Dossier = "D:\MonDossier\"
    
    'récupère les tous les fichiers du dossier
    Tbl = Fichiers(Dossier)
    
    'défini le critère de recherche
    Critere = "MonCritere"
    
    'parcour le tableau afin de rechercher
    'le critère dans les noms des classeurs
    For I = 1 To UBound(Tbl)
        
        'si trouvé
        If InStr(Tbl(I), Critere) Then
            
            'regarde dans les noms des feuilles du classeur si le critère
            's'y trouve aussi, si c'est le cas, récupère dans un autre tableau
            'le chemin et le nom du classeur
            If FeuilleExiste(Dossier & Tbl(I), Critere) = True Then
            
                J = J + 1
                ReDim Preserve TblRecup(1 To J)
                TblRecup(J) = Dossier & Tbl(I)
                
            End If
                            
        End If
        
    Next I
    
    'ici, affiche les classeurs qui peuvent correspondre
    For I = 1 To UBound(TblRecup)
        Debug.Print TblRecup(I)
    Next I
    
End Sub

'fonction tableau qui retourne tous les
'fichiers du dossier passé en argument
Function Fichiers(Chemin As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
    
    Fichier = Dir(Chemin)
    
    Do While (Len(Fichier) > 0)
    
        I = I + 1
        
        ReDim Preserve TableauFichiers(1 To I)
        
        TableauFichiers(I) = Fichier
        
        Fichier = Dir()
        
    Loop
    
    Fichiers = TableauFichiers()

End Function

Function FeuilleExiste(Fichier As String, _
                       Critere As String) As Boolean

    Dim Con As Object
    Dim Cat As Object
    Dim Feuille As Object
    
    'crée les objets de connection au classeur
    Set Con = CreateObject("ADODB.Connection")
    Set Cat = CreateObject("ADOX.Catalog")
    Set Feuille = CreateObject("ADOX.Table")
    
    Con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
             & Fichier & _
             ";Extended Properties=Excel 8.0;"
                     
    Set Cat.ActiveConnection = Con
    
    'parcour la collection de feuilles du classeur
    'pour voir si le critère se trouve dans un des noms
    'de feuille, si oui, retourne vrai
    For Each Feuille In Cat.Tables
        
        If InStr(Feuille.Name, Critere) <> 0 Then
        
            FeuilleExiste = True
            GoTo Fin
            
        End If
        
    Next Feuille

'mets fin à la connection
Fin:
    Con.Close
    Set Con = Nothing
    Set Cat = Nothing
    Set Feuille = Nothing
    
End Function

Hervé.

 

[groupes.blb]

Re : Recherche par mot clé

Merci beaucoup, je vais étudier !