Private
Sub
HandleFile(FullFilename
As
String
)
If
InStr(FullFilename,
"thumbs.dp"
) = 0
Then
End
If
End
Sub
Private
Function
CheckFile(FullFilename
As
String
)
As
Boolean
CheckFile = Right$(FullFilename, 4) =
".png"
End
Function
Private
Function
SearchFiles(Path
As
String
, FoundFiles
As
VBA.Collection)
As
Long
If
FoundFiles
Is
Nothing
Then
Set
FoundFiles =
New
VBA.Collection
End
If
Dim
strPath
As
String
Dim
strFilename
As
String
strPath = IIf(Right$(Path, 1) <>
"\", Path & "
\", Path)
On
Error
GoTo
ErrHandler
strFilename = Dir$(strPath, vbDirectory)
On
Error
GoTo
0
Dim
fileAttr
As
VbFileAttribute
Dim
colDirectories
As
VBA.Collection
Set
colDirectories =
New
VBA.Collection
Do
While
strFilename <> vbNullString
On
Error
GoTo
ErrHandler
fileAttr = -1
fileAttr = GetAttr(strPath & strFilename)
On
Error
GoTo
0
If
(fileAttr
And
vbDirectory) = vbDirectory
And
Not
(fileAttr
And
vbSystem) = vbSystem
Then
If
strFilename =
"."
Or
strFilename =
".."
Then
GoTo
Continue_Do
End
If
Call
colDirectories.Add(strPath & strFilename)
ElseIf
(fileAttr
And
vbNormal) = vbNormal
And
Not
(fileAttr
And
vbSystem) = vbSystem
Then
If
CheckFile(strPath & strFilename)
Then
Call
FoundFiles.Add(strPath & strFilename)
End
If
End
If
Continue_Do:
strFilename = Dir$()
Loop
DoEvents
Dim
vntDirectory
As
Variant
For
Each
vntDirectory
In
colDirectories
Call
SearchFiles(
CStr
(vntDirectory), FoundFiles)
Next
SearchFiles = FoundFiles.Count
Exit
Function
ErrHandler:
Debug.Print Format$(Now,
"yyyy-mm-dd"
); Tab(12);
"'"
; Err.Source;
"'"
; _
Tab(2);
"Path: '"
; strPath & strFilename;
"'"
; _
Tab(4);
"=> '"
; Err.Description;
"'"
Resume
Next
End
Function