Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/14.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 使用WinAPI递归搜索文件路径_Vba_Api_Recursion - Fatal编程技术网

Vba 使用WinAPI递归搜索文件路径

Vba 使用WinAPI递归搜索文件路径,vba,api,recursion,Vba,Api,Recursion,我从这里得到了下面的代码 我在其中添加了一行代码,将文件名存储在字典中 问题/ 我如何在字典中存储文件路径而不是文件名,你能帮我吗 Option Explicit Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long Private Declare PtrSafe Function FindFirstFileW Lib "kernel32" (ByVal lp

我从这里得到了下面的代码

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

问题/ 我如何在字典中存储文件路径而不是文件名,你能帮我吗

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
子测试()
作为长文件的Dim hFile
将sFileName设置为字符串
将wfd设置为WIN32_FIND_数据
作为对象的Dim dict
暗k一样长
变暗开始,变暗结束
Set dict=CreateObject(“Scripting.Dictionary”)
sFileName=“C:\Users\Administrator\Desktop\Desktop-\read\*.docx”最多可包含32767个字符
hFile=FindFirstFileW(StrPtr(sFileName),VarPtr(wfd))
开始=计时器
如果hFile句柄值无效,则
在FindNextFileW(hFile、VarPtr(wfd))时执行
dict.Add Key:=k,Item:=Left$(wfd.cFileName,InStr(wfd.cFileName,vbNullChar)-1)
k=k+1
环
FindClose文件
如果结束
完成=计时器
调试。打印完成-开始
子测试()
作为长文件的Dim hFile
将sFileName设置为字符串
将wfd设置为WIN32_FIND_数据
作为对象的Dim dict
暗k一样长

Dim sFolder As String’谢谢,我将把它转换成一个递归函数,以便与其他方法比较速度。。
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