FindFirstFileExWでFindExSearchLimitToDirectories、やっぱり使えないわな

Module1.bas

Option Explicit

Const FIND_FIRST_EX_LARGE_FETCH = 2& 'Win7以降

Const FindExInfoStandard = 0&
Const FindExInfoBasic = 1& 'Win7以降
Const FindExSearchLimitToDirectories = 1&

Private Declare PtrSafe Function FindFirstFileExW Lib "kernel32" _
                                                        (ByVal lpFileName As LongPtr, _
                                                        ByVal fInfoLevelId As Long, _
                                                        lpFindFileData As WIN32_FIND_DATAW, _
                                                        ByVal fSearchOp As Long, _
                                                        ByVal lpSearchFilter As LongPtr, _
                                                        ByVal dwAdditionalFlags As Long) As LongPtr
Private Declare PtrSafe Function FindClose Lib "kernel32" (ByVal hFindFile As LongPtr) As Long
Private Declare PtrSafe Function FindNextFile Lib "kernel32" Alias "FindNextFileW" (ByVal hFindFile As LongPtr, lpFindFileData As WIN32_FIND_DATAW) As Long

Private Type WIN32_FIND_DATAW
    dwFileAttributes As Long
    ftCreationTime As Currency
    ftLastAccessTime As Currency
    ftLastWriteTime As Currency
    nFileSizeHigh As Long
    nFileSizeLow  As Long
    dwReserved0   As Long
    dwReserved1   As Long
    cFileName(0 To 519) As Byte
    cAlternateFileName(0 To 27) As Byte
End Type
Const INVALID_HANDLE_VALUE = -1&
Const ERROR_CALL_NOT_IMPLEMENTED = 120&


Sub TEST2()
    Dim sPath$
    Dim k&
    Dim t!
    t = Timer
    
    Dim folderLV As Long
    folderLV = 1
    sPath = "D:\"

    ' ルートフォルダから探索開始
    SEARCH_SUB_FOLDER sPath, k

    Debug.Print "API"; k, Timer - t

End Sub


Private Sub SEARCH_SUB_FOLDER(ByVal sPath As String, ByRef k As Long)
    Dim sFilename     As String
    Dim lngAttribute    As Long
    Dim hFile           As LongPtr
    Dim wfd             As WIN32_FIND_DATAW
    Dim lngResult       As Long

    ' 検索するパス お尻に\が必要
    If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
    
    ' 最初のファイルを検索する。
    hFile = FindFirstFileExW(StrPtr(sPath & "*"), FindExInfoStandard, wfd, FindExSearchLimitToDirectories, 0, FIND_FIRST_EX_LARGE_FETCH)
    If hFile = INVALID_HANDLE_VALUE Then Exit Sub
    
    Do
        ' ファイル名を得る。
        sFilename = wfd.cFileName
        sFilename = Left$(sFilename, InStr(sFilename, vbNullChar) - 1)

        ' ファイルの属性がフォルダの場合。
        If (wfd.dwFileAttributes And vbDirectory) Then
            ' 「.」「..」以外を対象とする。
            If Not (sFilename Like ".*") Then
                k = k + 1
                Debug.Print sPath & sFilename & "\"
                
                '配下のフォルダの検索
                SEARCH_SUB_FOLDER sPath & sFilename & "\", k
            End If
        Else
            'Debug.Print "file"
        End If

    ' 次のファイルを検索する。
    Loop While FindNextFile(hFile, wfd)

    ' ハンドルを閉じる。
    FindClose hFile

End Sub