Solved: VB6 FileSearch

[mdmackillop]

Hi All,
Is there a VB6 equivalent to VBA FileSearch? I'm trying to adapt the following code to check a multi-card reader for jpg files.
Regards
MD


Sub Searches()
Dim fs, drv, d, i As Long
drv = Array("F:\", "H:\", "I:\", "J:\", "K:\", "L:\")
Set fs = Application.FileSearch
For Each d In drv
With fs
.LookIn = d
.SearchSubFolders = True
.FileName = "*.jpg"
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
End With
Next
End Sub

[mvidas]

Hey Malcolm,

No direct equivalent, but you can still search for the files easy enough:'see code belowMatt

[mvidas]

After thinking a little bit about this, if you like being able to set the properties and everything, it really wouldn't be too much work making a class module for this, so you can use it pretty much the same way. I'm sure if you hunted around at freevbcode.com you could probably find an already made one too.
Just a thought

[mdmackillop]

Thanks Matt,
I'll take this to work and give it a try.
Regards
Malcolm

[mdmackillop]

Hi Matt,
Finally I got round to implementing this and it works fine; especially after I changed my Option Base 1 to Base 0
Regards
Malcolm

[mvidas]

Good to hear.. what were you using option base 1 for anyways? :)

I actually modified this a little bit to search for anything (not just jpg) for use in something I did a couple days ago, so I've updated the above code and included the option base 0.
For what it is worth, heres what you'd need to change to keep option base 1:'see code belowMatt

[mdmackillop]

Thanks Matt.
For anyone else following this thread, Matt's code can combine with =Johnske's here http://www.vbaexpress.com/forum/showthread.php?t=8312 to automate importing and handling of photo cards in a multi card reader
Regards
MD

[mvidas]

Interesting thread there.. I would also go with WMI, but as long as it works for you theres no problem!
Again for what it is worth, I re-wrote the file search again so it works regardless of what the option base is set at. Had to add a function to find it too, wasn't sure how the best way to do that was, so if you know of a better way than I'm using please let me know!Sub ExampleSub()
Dim drv(), d, FileList() As String, i As Long
drv = Array("F:\", "H:\", "I:\", "J:\", "K:\", "L:\")
ReDim FileList(GetOptionBase)
For Each d In drv
vFileSearch d, FileList ', "jpg"
Next
If Len(FileList(LBound(FileList))) > 0 Then 'make sure at least one file
Debug.Print "Total files found: " & CStr(UBound(FileList) - LBound(FileList) + 1)
For i = LBound(FileList) To UBound(FileList)
Debug.Print FileList(i)
Next
End If
End Sub
Function vFileSearch(ByVal vPath As String, ByRef vsArray() As String, _
Optional ByVal vExt As String = "*") As Boolean
Dim tempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
If Len(vsArray(LBound(vsArray))) = 0 Then
Cnt = LBound(vsArray)
Else
Cnt = UBound(vsArray) + 1
End If
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
On Error Resume Next 'in case no 'read' rights to directory
tempStr = Dir(vPath & "*.", vbDirectory)
On Error GoTo 0
dirCnt = LBound(vsArray)
Do Until Len(tempStr) = 0
If Left(tempStr, 1) <> "." Then
ReDim Preserve vDirs(dirCnt)
vDirs(dirCnt) = tempStr
dirCnt = dirCnt + 1
End If
tempStr = Dir
Loop
On Error Resume Next 'in case no 'read' rights to directory
tempStr = Dir(vPath & "*." & vExt)
On Error GoTo 0
Do Until Len(tempStr) = 0
ReDim Preserve vsArray(Cnt)
vsArray(Cnt) = vPath & tempStr
Cnt = Cnt + 1
tempStr = Dir
Loop
If dirCnt > LBound(vsArray) Then
For dirCnt = LBound(vDirs) To UBound(vDirs)
If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
vFileSearch vPath & vDirs(dirCnt), vsArray, vExt
End If
Next
End If
End Function
Function GetOptionBase() As Long
Dim TempArray(1) As Long
GetOptionBase = LBound(TempArray)
End FunctionMatt