递归使用win API搜索文件路径

时间:2016-03-18 16:50:56

标签: vba api recursion

我从这里获得了以下代码Optimize Speed of Recursive File Search

我在其中添加了一行代码以将文件名存储在字典中

问题/ 如何在字典中存储文件路径而不是文件名,请帮助我。

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

1 个答案:

答案 0 :(得分:0)

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