Skip to content

Instantly share code, notes, and snippets.

@kumatti1 kumatti1/Module1.bas
Last active Aug 29, 2015

Embed
What would you like to do?
FindFirstFileExWでFindExSearchLimitToDirectories、やっぱり使えないわな
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.