Solved

How do I use Filesearch with VB6?

Posted on 2004-08-05
16
1,614 Views
Last Modified: 2007-11-27
I haven't been able to find a working sample of filesearch to find a file anywhere on a system, to include network drives, if they exist.
Anyone have code that I can use?
Thanks,
Russ
0
Comment
Question by:RUSS_EMI
  • 6
  • 4
  • 3
  • +1
16 Comments
 
LVL 5

Expert Comment

by:ZenMasterrr
ID: 11724063
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 11724423
This is what I use

Option Explicit

Public Function DriveExists(TargetDrive As String)
    On Error GoTo DriveExistsError
    ChDrive TargetDrive
    DriveExists = True
DriveExistsExit:
    Exit Function
DriveExistsError:
    Resume DriveExistsExit
End Function


Sub LookForFiles(strFolder As String, strFiles() As String, strFilePattern As String, iFileCount As Integer)
Dim strFileName
Dim strFolders() As String
Dim iFolderCount As Integer
Dim strFilePatterns
Dim i As Integer

strFileName = Dir$(strFolder & "\*", vbDirectory)
Do Until strFileName = ""
    If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
        If Left$(strFileName, 1) <> "." Then
            ReDim Preserve strFolders(iFolderCount)
            strFolders(iFolderCount) = strFolder & "\" & strFileName
            iFolderCount = iFolderCount + 1
        End If
    End If
    strFileName = Dir$()
Loop

strFilePatterns = Split(strFilePattern, ";")
For i = 0 To UBound(strFilePatterns)
    strFileName = Dir$(strFolder & "\" & strFilePatterns(i), vbDirectory)
    Do Until strFileName = ""
        ReDim Preserve strFiles(iFileCount)
        strFiles(iFileCount) = strFolder & "\" & strFileName
        iFileCount = iFileCount + 1
        strFileName = Dir$()
    Loop
Next i
For i = 0 To iFolderCount - 1
    LookForFiles strFolders(i), strFiles(), strFilePattern, iFileCount
Next i
End Sub

Private Sub Command1_Click()
Dim strFiles() As String
Dim iFileCount As Integer
Dim iDriveNumber As Integer
Dim strDriveletter As String
For iDriveNumber = 1 To 26
    strDriveletter = Chr$(Asc("A") + iDriveNumber - 1)
    If DriveExists(strDriveletter) Then
        LookForFiles strDriveletter & ":", strFiles(), "*.frm;*.bas", iFileCount
    End If
Next iDriveNumber
End Sub


0
 

Author Comment

by:RUSS_EMI
ID: 11724535
Thanks to both of you.  
The first example finds them OK, but I must specify the drive and only the extension.
The second I'm not clear on where I will see the results (I did add command1 on the form)
Here is what I need to do;
1. find all occurrences of a constant FILENAME.EXT.
2. If there is only 1 found display it in a msgbox, if more then 1, display all locations in a combobox for the end user to select one.
Please excuse me for not thinking this all the way through the first time.
Russ
0
 
LVL 5

Expert Comment

by:ZenMasterrr
ID: 11724566
russ .... go with grahamskan's code to search and locate these files, and use the code from the example i indicated to add to list or combo

zen :))
0
 

Author Comment

by:RUSS_EMI
ID: 11724892
zen,
   Thanks.  I tried to run the code, (after adding a command1), but got an error 32 (bad filename or number).  Am I missing a reference or forgot to initialize a variable?
Russ
0
 
LVL 5

Expert Comment

by:ZenMasterrr
ID: 11725478
command1 is the get button I asssume ?
0
 
LVL 11

Accepted Solution

by:
ajaikumarr earned 150 total points
ID: 11725563
Hai,

I've just changed [GrahamSkan] code to get it run.
Add a Combo1, Text1, Command1 to run this code.

Option Explicit

Public Function DriveExists(TargetDrive As String)
    On Error GoTo DriveExistsError
    ChDrive TargetDrive
    DriveExists = True

DriveExistsExit:
    Exit Function

DriveExistsError:
    Resume DriveExistsExit
End Function


Sub LookForFiles(strFolder As String, strFiles() As String, strFilePattern As String, iFileCount As Integer)
    On Error GoTo LookForFilesErrorHandler
    Dim strFileName
    Dim strFolders() As String
    Dim iFolderCount As Integer
    Dim strFilePatterns
    Dim i As Integer
   
    strFileName = Dir$(strFolder & "\*", vbDirectory)
    Do Until strFileName = ""
        If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
        strFileName = Dir$()
    Loop
   
    strFilePatterns = Split(strFilePattern, ";")
    For i = 0 To UBound(strFilePatterns)
        strFileName = Dir$(strFolder & "\" & strFilePatterns(i), vbDirectory)
        Do Until strFileName = ""
            ReDim Preserve strFiles(iFileCount)
            strFiles(iFileCount) = strFolder & "\" & strFileName
            Me.Combo1.AddItem (strFiles(iFileCount))
            iFileCount = iFileCount + 1
            strFileName = Dir$()
        Loop
    Next i
    For i = 0 To iFolderCount - 1
        LookForFiles strFolders(i), strFiles(), strFilePattern, iFileCount
    Next i

LookForFilesErrorHandler:
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Command1_Click()
    If Me.Text1.Text = "" Then
        MsgBox ("Please provide the file name")
        Exit Sub
    End If
   
    Dim strFiles() As String
    Dim iFileCount As Integer
    Dim iDriveNumber As Integer
    Dim strDriveletter As String
    For iDriveNumber = 1 To 26
        strDriveletter = Chr$(Asc("A") + iDriveNumber - 1)
        If DriveExists(strDriveletter) Then
            LookForFiles strDriveletter & ":", strFiles(), Me.Text1.Text, iFileCount
        End If
    Next iDriveNumber
End Sub

Bye
Ajai
0
 

Author Comment

by:RUSS_EMI
ID: 11725603
With no explanation either, I hooked G's code for Command1_Click() to command1 button.  The program errors when the strFileName = "??? ???????? ????????.doc" in a large directory.  This while I am actually searching for "*.mdb" (of which there are only 2 dozen or so).  Can you get the above code to work?
Russ
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
LVL 11

Expert Comment

by:ajaikumarr
ID: 11725697
Hai,

Here you can see a bunch of file search with Explanations.
http://vbnet.mvps.org/index.html?code/toc/tocbytopic_b.htm

Bye
Ajai
0
 
LVL 11

Expert Comment

by:ajaikumarr
ID: 11725717
0
 
LVL 11

Expert Comment

by:ajaikumarr
ID: 11725788
Hai,

Please run the code which i posted... It's working fine here...

Bye
Ajai
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 11731016
Hi RUSS_EMI,

I'm sorry I didn't provide the topping and tailing. I wasn't sure of your context. I presumed that you could do that yourself.

The array: 'strFiles' in this sub should hold the results

Private Sub Command1_Click()
Dim strFiles() As String
Dim iFileCount As Integer
Dim iDriveNumber As Integer
Dim strDriveletter As String
For iDriveNumber = 1 To 26
    strDriveletter = Chr$(Asc("A") + iDriveNumber - 1)
    If DriveExists(strDriveletter) Then
        LookForFiles strDriveletter & ":", strFiles(), "*.frm;*.bas", iFileCount
    End If
Next iDriveNumber
End Sub

Regarding the error that you report. What is it?
0
 

Author Comment

by:RUSS_EMI
ID: 11732551
I figured the strFiles out, the problem is I get an error 32 gad filename or number when I run it on my PC.  I don't know why, perhaps it is a number limitation?  Running the debugger the filename at the error is "??? ??????? ??? ??????.doc".  even though i'm looking for "*.mdb".
Thanks,
Russ
0
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 350 total points
ID: 11733120
You don't say where in the program that you get the error, but I would guess it's in the folder search part. Is it on the GetAttr line?
The pattern to look for folders does not exclude any files - folder names can have an extension. If it finds one with an illegal file name, then it will give an error.

I've interpreted '32 gad filename or number' as '52 Bad file name or number' and added an error routine to skip to the next file or folder if that happens. The procedure will terminate if any other error occurs.

I can't test it because I can't create or rename a file to match yours. I would suggest that you delete the file.

Sub LookForFiles(strFolder As String, strFiles() As String, strFilePattern As String, iFileCount As Integer)
Dim strFileName
Dim strFolders() As String
Dim iFolderCount As Integer
Dim strFilePatterns
Dim i As Integer
Dim bGoodName As Boolean
On Error GoTo LookForFilesError
strFileName = Dir$(strFolder & "\*", vbDirectory)
Do Until strFileName = ""
    bGoodName = True
    If (GetAttr(strFolder & "\" & strFileName) And vbDirectory) = vbDirectory Then
        If bGoodName Then
            If Left$(strFileName, 1) <> "." Then
                ReDim Preserve strFolders(iFolderCount)
                strFolders(iFolderCount) = strFolder & "\" & strFileName
                iFolderCount = iFolderCount + 1
            End If
        End If
    End If
    strFileName = Dir$()
Loop

strFilePatterns = Split(strFilePattern, ";")
For i = 0 To UBound(strFilePatterns)
    strFileName = Dir$(strFolder & "\" & strFilePatterns(i), vbDirectory)
    Do Until strFileName = ""
        ReDim Preserve strFiles(iFileCount)
        strFiles(iFileCount) = strFolder & "\" & strFileName
        iFileCount = iFileCount + 1
        strFileName = Dir$()
    Loop
Next i
For i = 0 To iFolderCount - 1
    LookForFiles strFolders(i), strFiles(), strFilePattern, iFileCount
Next i
LookForFilesExit:
Exit Sub
LookForFilesError:
Select Case Err.Number
    Case 52
        bGoodName = False
        Resume Next
    Case Else
        MsgBox "Unexpected error: " & Err.Number & ", " & Err.Description
        Resume LookForFilesExit
End Select
End Sub


0
 

Author Comment

by:RUSS_EMI
ID: 11733202
Thank you, you probably are correct on the error number and problem area.  I will try this code and get back to you.
Again, thank you for your time and efforts.
Russ
0
 

Author Comment

by:RUSS_EMI
ID: 11741364
Thank you all.  I gave most points G., because it was his code that I used primarily.  I gave the accepted solution to A. because it was most complete, functional answer for future reference.  I trust that is satisfactory.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now