[VB.NET -> VBA]Moteur de recherche pour disque dur

Signaler
-
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
-
Bonjour à tous,

je vous explique brièvement ma situation. J'effectue actuellement mon stage de fin d'étude dans une entreprise au service qualité. Lorsque je suis arrivée, l'un des projets que l'on m'a confié était de restructurer le disque dur du département de façon à optimiser le flux d'informations. J'ai dès lors émis l'idée de "programmer" un moteur de recherche multi-critères en faisant une macro sur excel dont la base de données est l'ensemble du "disque dur" du département.

J'ai réussi à éditer une macro permettant de pouvoir rechercher n'importe quel fichier dans un répertoire (comportant lui-même de nombreux répertoires et donc énormément de fichiers) en fonction de son nom, sa date de création et son auteur.

L'intéret de ce "moteur de recherche" était que l'on puisse trouver rapidement le fichier recherché sur le répertoire principal (=disque dur du département) ET de pouvoir l'ouvrir en cliquant simplement sur la donnée correspondante(grâce à une userform contenant une ListBox des fichiers).

Le problème est que la macro ne supporte buggue car la taille du répertoire en question atteindra vraisemblablement une taille définitive de 5GB. En gros, ma macro marche avec des répertoires contenant peu de sous-répertoires et fichiers, mais pas à partir d'un certain seuil. Avec un répertoire de 1GB c'est le bug.

Ma question est la suivante: est ce que je peux déja abandonner l'idée de faire un moteur de recherche sur vba car la macro ne supportera pas la taille de mon répertoire?

Si c'est possible, j'aurais grandement besoin de votre aide :)

Si ce n'est pas possible, vers quel programme devrais-je me tourner pour réaliser ce moteur de recherche? Je n'ai pas de grandes connaissances en programmation, un ami déja aidé pour cette macro mais il en peut plus de moi

En tous cas, mes supérieurs sont très enthousiastes à l'idée de posséder un tel outil et je suis à deux doigts de jeter mon pc par la fenêtre...

Merci d'avance pour votre aide!
Coccinelle22

6 réponses


Bonjour,

Apparemment tu l'as déjà choisi le langage puisque tu es dans la section VB.NET.

Tu devrais te documenter sur System.IO.Directory.EnumerateFiles dans ce cas.

PS: Pour ton appli en VBA, que le dossier fasse 1ko ou 1To c'est du pareil au même sauf qu'il va mettre plus de temps à le faire (s'il contient plus de fichiers)

Cordialement


CF2i - Guadeloupe
Ingénierie Informatique
Messages postés
728
Date d'inscription
samedi 4 avril 2009
Statut
Membre
Dernière intervention
30 mars 2014
4
Bonjour,

TU AS MULTIPOSTE
0h30 après sur le site du 0, n'attendant même pas un délai raisonnable de réponse, d'autant que c'est plutôt du VBA ta question, et non du vbNet !

Ici :

http://www.siteduzero.com/forum/sujet/moteur-de-recherche-pour-disque-dur?page=1#message-84386533

Cordialement, Joe.

>EhJoe: Je suis nouvelle sur le forum...Je pensais juste que je pourrais avoir de l'aide sur les deux forums

>Acive: Merci pour la solution System.IO.Directory.EnumerateFiles. Je vais me renseigner sur comment je pourrais l'utiliser.

Concernant mon appli, c'est justement le temps pour "charger" l'ensemble des données qui est problématique. Pour un répertoire de moins de 1Go, cela nécessite pret de 4minutes pour que la liste de données+liens soit générée ou alors cela buggue tout simplement (fermeture d'excel etc..)

Existe-il un moyen quelconque de "soulager" ce temps de chargement ou alors serait-il bénéfique que je me tourne vers un autre support pour créer ce moteur de recherche pour "grand répertoire"?
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
224
Bonjour,

A lire :
Tapez le texte de l'url ici.
et pour toi, c'est à multiplier, puisque :
pouvoir rechercher n'importe quel fichier dans un répertoire (comportant lui-même de nombreux répertoires et donc énormément de fichiers) en fonction de son nom, sa date de création et son auteur
.
Quant au reste (bug si trop "volumineux") : on se sait pas comment "tu" as codé tout cela ... alors ... que veux-tu qu'on te réponde en ce qui concerne cet aspect ? ===>> forcément : rien !
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

Option Explicit

'Nécessite d'activer
  ' la référence "Microsoft Scripting RunTime"
  ' La référence "Microsoft Shell Controls and Automation"
    ' Cliquez sur le bouton OK pour valider.

Dim Data()
Dim NBdata As Integer
Dim objShell As Shell32.Shell

Sub Lecture()
Dim J As Long

  Application.ScreenUpdating = False
  
  ' Définit le répertoire pour débuter la recherche de fichiers.
  ' (MAIS AVEC UN REPERTOIRE CONTENANT BEAUCOUP DE SOUS-REPERTOIRES ET FICHIERS, CELA PREND UNE ETERNITE OU BUGGUE).
  'LeChemin = "C:\Maxi_Repertoire"
  
  If "C:\Maxi_Repertoire" = "" Then Exit Sub
  
  NBdata = 1
  ReDim Data(1 To 5, 1 To NBdata)
  Data(1, NBdata) = "Nom"
  Data(2, NBdata) = "Année de création"
  Data(3, NBdata) = "Auteur"
  Data(4, NBdata) = "Chemin"
  'Data(5, NBdata) = "Chemin + fichier"

  Set objShell = CreateObject("Shell.Application")
  
  ListeFichiers "C:\Maxi_Repertoire"
  
  With Sheets("Liste Fichiers")
    .Cells.Clear
    .Range("A1").Resize(UBound(Data, 2), 4) = Application.Transpose(Data)
    .Columns("A:E").AutoFit
    For J = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      .Hyperlinks.Add Anchor:=.Range("E" & J), Address:=Data(5, J), TextToDisplay:=Data(1, J)
    Next J
  End With
  
  Set objShell = Nothing    ' Libère la mémoire
  Erase Data                ' Libére la mémoire
End Sub

Sub ListeFichiers(Rep As String)
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
'Dim T As Double
Dim objFolder As Shell32.Folder
Dim strFileName As Shell32.FolderItem
  

  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = Fso.GetFolder(Rep)
          
  For Each FileItem In SourceFolder.Files
    NBdata = NBdata + 1
    ReDim Preserve Data(1 To 5, 1 To NBdata)
    Data(1, NBdata) = FileItem.Name
    
    'Data(2, NBdata) = FileItem.DateCreated
    Data(2, NBdata) = Year(FileItem.DateCreated)
    
    Set objFolder = objShell.Namespace(CStr(FileItem.ParentFolder))     ' il faut forcer en String
    Set strFileName = objFolder.Items.Item(FileItem.Name)
    If objFolder.GetDetailsOf(strFileName, 20) <> "" Then
      Data(3, NBdata) = objFolder.GetDetailsOf(strFileName, 20)
    Else
      Data(3, NBdata) = ""
    End If
    
    Data(4, NBdata) = FileItem.ParentFolder
    
'    T = FileItem.Size
'    If T < 99999 Then
'      Data(4, NBdata) = T & " Bytes"
'    ElseIf T < 999999 Then
'      Data(4, NBdata) = Round(T / 1000, 1) & " Ko"
'    Else
'      Data(4, NBdata) = Round(T / 1000000, 1) & " Mo"
'    End If
    
    Data(5, NBdata) = FileItem.ParentFolder & "" & FileItem.Name
    
    Set objFolder Nothing: Set strFileName Nothing
  Next FileItem
    
  '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
  For Each SubFolder In SourceFolder.subfolders
    ListeFichiers SubFolder.Path
  Next SubFolder
            
End Sub



Et pour ma Useform:

Option Explicit

Private Sub ComboBox1_Change()
' Les noms
  If Me.ComboBox1 <> "" Then
    Me.ComboBox2 "": Me.ComboBox3 ""
    Col 1: Trouv Me.ComboBox1
    Call Rech
  End If
End Sub

Private Sub ComboBox2_Change()
' L'année
  If Me.ComboBox2 <> "" Then
    Me.ComboBox1 "": Me.ComboBox3 ""
    Col 2: Trouv Me.ComboBox2
    Call Rech
  End If
End Sub

Private Sub ComboBox3_Change()
' Auteur
  If Me.ComboBox3 <> "" Then
    Me.ComboBox1 "": Me.ComboBox2 ""
    Col 3: Trouv Me.ComboBox3
    Call Rech
  End If
End Sub

Private Sub CommandButton2_Click()
  Unload Me
End Sub


Private Sub CommandButton3_Click()
' Réactualisation
  LeChemin = ""
  Me.ListBox1.Clear
  DoEvents
  Lecture
  UserForm_Initialize
End Sub

Private Sub ListBox1_Click()
Dim Ligne As Long

  Ligne = Me.ListBox1.List(Me.ListBox1.ListIndex, 5)
  
  With Sh.Cells(Ligne, 5)
    If .Hyperlinks.Count > 0 Then
      .Hyperlinks(1).Follow NewWindow:=True
    End If
  End With
End Sub

Private Sub UserForm_Initialize()
Dim Cel As Range
Dim LesNoms As Object, LesPrenoms As Object, LesDates As Object, Auteurs As Object
Dim Temp

  Set Sh = Sheets("Liste_Fichiers")
  
  Set LesNoms = CreateObject("Scripting.Dictionary")
  Set LesDates = CreateObject("Scripting.Dictionary")
  Set Auteurs = CreateObject("Scripting.Dictionary")

  For Each Cel In Sh.Range("A2:A" & Sh.[A65000].End(xlUp).Row)
    LesNoms(Cel.Value) = Cel.Value
    LesDates(Cel.Offset(, 1).Value) = Cel.Offset(, 1).Value
    Auteurs(Cel.Offset(, 2).Value) = Cel.Offset(, 2).Value
  Next Cel
  
  Temp = LesNoms.Items: Call tri(Temp, LBound(Temp), UBound(Temp))
  Me.ComboBox1.List = Temp
  Temp = LesDates.Items: Call tri(Temp, LBound(Temp), UBound(Temp))
  Me.ComboBox2.List = Temp
  Temp = Auteurs.Items: Call tri(Temp, LBound(Temp), UBound(Temp))
  Me.ComboBox3.List = Temp
  Col 1: Trouv "*": Rech
End Sub

Sub tri(A, gauc, droi)
Dim Ref, G As Long, D As Long
Dim Temp

  Ref = A((gauc + droi) \ 2)
  G gauc: D droi
  Do
    Do While A(G) < Ref: G = G + 1: Loop
    Do While Ref < A(D): D = D - 1: Loop
    If G <= D Then
      Temp A(G): A(G) A(D): A(D) = Temp
      G G + 1: D D - 1
    End If
  Loop While G <= D
  If G < droi Then Call tri(A, G, droi)
  If gauc < D Then Call tri(A, gauc, D)
End Sub
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
224
Déja :
Dim NBdata As Integer

fait que la limite de NBdata est celle d'un Integer (32 767)

________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.