Recursive Search for file paths using win API

Question

I got the below code from here Optimize Speed of Recursive File Search

i added one line of code to it to store file names in a dictionary

Question/ how can I store the file paths instead of file names in the dictionary, could you help me please.

Option Explicit

Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long
Private Declare PtrSafe Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr
Private Declare PtrSafe Function FindNextFileW Lib "kernel32" (ByVal hFindFile As LongPtr, ByVal lpFindFileData As LongPtr) As LongPtr

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Const MAX_PATH As Long = 260
Const ALTERNATE As Long = 14

' Can be used with either W or A functions
' Pass VarPtr(wfd) to W or simply wfd to A
Private 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 * ALTERNATE
End Type

Private Const INVALID_HANDLE_VALUE As LongPtr = -1

'-------------------------------------------------------------

Sub test()
        Dim hFile As LongPtr
        Dim sFileName As String
        Dim wfd As WIN32_FIND_DATA
        Dim dict As Object
        Dim k As Long
        Dim Start, finish As Variant
        Set dict = CreateObject("Scripting.Dictionary")

        sFileName = "C:\Users\Administrator\Desktop\desktop-\read\*.docx"    ' Can be up to 32,767 chars

        hFile = FindFirstFileW(StrPtr(sFileName), VarPtr(wfd))
        Start = Timer
        If hFile <> INVALID_HANDLE_VALUE Then
            Do While FindNextFileW(hFile, VarPtr(wfd))

                dict.Add Key:=k, Item:=Left$(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1)
                k = k + 1
            Loop

            FindClose hFile
        End If
        finish = Timer
        Debug.Print finish - Start

score 0 · Answer 1 · answered Mar 18 '16 at 17:10

Sub test()
        Dim hFile As LongPtr
        Dim sFileName As String
        Dim wfd As WIN32_FIND_DATA
        Dim dict As Object
        Dim k As Long
        Dim sFolder As String'<<<

        Set dict = CreateObject("Scripting.Dictionary")

        sFolder = "C:\Users\Administrator\Desktop\desktop-\read\" '<<<
        sFileName = sFolder & "*.docx"    ' Can be up to 32,767 chars

        hFile = FindFirstFileW(StrPtr(sFileName), VarPtr(wfd))

        If hFile <> INVALID_HANDLE_VALUE Then
            Do While FindNextFileW(hFile, VarPtr(wfd))

                dict.Add Key:=k, Item:=sFolder & _
                         Left$(wfd.cFileName, InStr(wfd.cFileName, vbNullChar) - 1) '<<<
                k = k + 1
            Loop

            FindClose hFile
        End If
End Sub

thanks, i'll turn it into a recursive function to compare the speed with other methods.. — Ali_R4v3n, Mar 18 '16 at 17:25

Recursive Search for file paths using win API

1 Answers1