[VBA + ACC07] Zoekfunctie in submappen

[Josh]

Eigenlijk is dit topic net zo goed thuis in Programming, maar aangezien het in dit specifieke geval om Access gaat heb ik het hier geplaatst.

In de database die ik gebruik staan artikelen met een tekeningnummer. De technische tekeningen zijn opgeslagen in een netwerkmap (totaa: 54.000 tekeningen, 104 mappen, 28 GB). Met een druk op de knop wil ik deze tekening op kunnen zoeken op de netwerkschijf. Op zich ias dit geen 'rocket science' met de Dir() functionaliteit in VB, ware het niet voor het feit dat deze functie geen submappen ondersteund.

De meest logische oplossing is een 'recursive call' gebruiken. Een aantal voorbeeldscripts heb ik bij elkaar gesprokkeld, verbeterd en hiermee heb ik de volgende functie geschreven:

Visual Basic: SearchFiles

' -------------------------------------------------------------------------------
' 1. Search files in 'strDir' and create a list with files
'    that are found 'colFiles' with their full path included.
' 2. Can search in subdirectories if needed (InclSubDirs).
' 3. A file mask 'strFileMask' can be set to specify the name or extension of the file.
' -------------------------------------------------------------------------------
Public Function SearchFiles(colFiles As Collection, strDir As String, strFileMask As String, bInclSubDirs As Boolean)

    Dim strDirFile As String
    Dim colFolders As New Collection
    Dim vFolderName As Variant
    
    ' Prepare the path: add a backslash and trim any spaces
    strDir = Trim(strDir)
    If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
    
    'Add files in strDir matching strFileMask to colFiles
    strDirFile = Dir(strDir & strFileMask)
    Do While strDirFile <> vbNullString
        colFiles.Add strDir & strDirFile
        strDirFile = Dir
    Loop

    'Fill colFolders with list of subdirectories of strDir
    If bInclSubDirs Then
        strDirFile = Dir(strDir, vbDirectory)
        Do While strDirFile <> vbNullString
            If (strDirFile <> ".") And (strDirFile <> "..") Then
                If (GetAttr(strDir & strDirFile) And vbDirectory) <> 0 Then
                    colFolders.Add strDirFile
                End If
            End If
            strDirFile = Dir
        Loop

        'Recursively call SearchFiles for each subfolder in colFolders
        For Each vFolderName In colFolders
            Call SearchFiles(colFiles, strDir & vFolderName, strFileMask, True)
        Next vFolderName
    End If
End Function

Een knop roept de Zoekfunctie als volgt:

Visual Basic: Knop voor Zoekfunctie

Private Sub cmdFetch_Click()
    Dim Drawing As String

    Drawing = Me.txtDrawing.Value
    
    ' Call the search function.
    Dim colFiles As New Collection
    SearchFiles colFiles, "F:\Tekeningen\", Drawing, True

    ' Print list to debug window
    Dim vFile As Variant
    For Each vFile In colFiles
        Debug.Print vFile
    Next vFile
    
    ' Print to debug window when no file was found
    If colFiles.Count = 0 Then
        Debug.Print "Could not find file!"
    End If
End Sub

Het probleem hiermee is echter dat de code veel en veel te langzaam is. Het duurt ongeveer 42 seconden om een bestand te zoeken terwijl dit in de verkenner, met dezelfde bestandsnaam slechts enkele seconden duurt. Is er een manier om dit script te verbeteren? Via msdn heb ik al wat informatie gevonden die belangrijk is bij het 'recursive' aanroepen van functies, maar ik ben simpelweg niet handig genoeg met VB om dit nog meer te versnellen.

Wat denken jullie ervan?

[ Voor 5% gewijzigd door Josh op 06-05-2011 16:30 ]

[Marko_J]

Is het een idee om het volledige pad naar de tekening op te slaan in je datastructuur?

[mhoogendam]

Zou het in de verkenner niet sneller gaan omdat hier gebruik gemaakt word van de indexing service?
Je kan via VB ook de indexing service API raadplegen:
MSDN: Using Visual Basic with Indexing Service APIs (Windows)
http://www.codeproject.co...exing_Service_HOW-TO.aspx

[Josh]

Marko_J schreef op vrijdag 06 mei 2011 @ 23:39:
Is het een idee om het volledige pad naar de tekening op te slaan in je datastructuur?

Goede vraag, dat is natuurlijk de eerste gedachte die ook in mij op kwam. Maar het antwoord is simpelweg: "Nee." Het is teveel werk om alles 'handmatig' te indexeren, bovendien is de netwerkmap dynamisch (mappen veranderen af en toe).

mhoogendam schreef op maandag 09 mei 2011 @ 08:39:
Zou het in de verkenner niet sneller gaan omdat hier gebruik gemaakt word van de indexing service?
Je kan via VB ook de indexing service API raadplegen:
MSDN: Using Visual Basic with Indexing Service APIs (Windows)
http://www.codeproject.co...exing_Service_HOW-TO.aspx

We werken hier nog onder Windows XP en voor zover ik weet indexeert deze niet? Als ik de zoekfunctie gebruik zie ik overduidelijk dat hij alle mapjes afzoekt, wat erop wijst dat hij geen index gebruikt. De API is dus ook niet te gebruiken. Goede tip desondanks!

Het tweede artikel is eigenlijk nog beter, maar het probleem daarmee is dat ik de 'Indexing service' op elke machine moet aanzetten. Aangezien ik niet onderdeel uitmaak van de IT heb ik dus nagenoeg geen kans dat ik dit voor elkaar zal krijgen, ik heb geen adminrechten.

---

Inmiddels ben ik dit artikel tegen gekomen waarin verwezen wordt naar een aantal interessante bronnen. De bronnen zijn echter VB studio en werken niet in Access. Toch is de functie (klik link) een interessante optie. Echter krijg ik het niet werkend...

Visual Basic:

Function findPath(strId As String) As String
    Dim strBase As String
    strBase = "F:\Tekeningen\"

    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")

    Dim baseFolder As Object
    Set baseFolder = fs.getfolder(strBase)

    Dim folder As Object

    For Each folder In baseFolder.subfolders
        If InStr(1, folder.name, strId) > 0 Then
            findPath = strBase & "\" & folder.name
            Debug.Print folder
            Exit Function
        End If
    Next folder
End Function

Private Sub cmdSuperFetch_Click()
    findPath("BESTANDSNAAM.*")
End Sub

Als ik de knop klik krijg ik geen foutmelding, maar ook niets te zien in het immediate venster.

[ Voor 26% gewijzigd door Josh op 09-05-2011 10:15 ]

[Josh]

Even een nieuwe post, aangezien ik een prima oplossing gevonden heb.

Aangezien de FileSearch functie in Office 2007 verwijdert is moest MS met een vervanger komen. Daarover wordt hier gesproken: Microsoft Support. Vervolgens kun je hier de workaround vinden, hierbij wordt gebruik gemaakt van de FileSystemObject class. Het enige nadeel hiervan is dat je de Microsoft Scripting Runtime (Scrrun.dll) in de refenties moet aanvinken, maar dat zie ik niet perse als een groot probleem.

Zoeken duurt nu slechts enkele seconden en ik heb bovendien ook een mooiere code!

Ondanks dat de oplossing gevonden is, gelieve topic open laten omdat dit een interessant onderwerp is om verder te bespreken.