Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

search for all files contained in a textfile vb6

Posted on 2004-09-26
14
Medium Priority
?
281 Views
Last Modified: 2011-09-20
Hello Experts

I have some code below which will search through the c:\ drive
it searches for the file contained in variable ( sSrchString )

what id like to do is have a text file   filenames.txt which contains 5 or more files
to search for

filenames.txt  could have any amount of different files e.g

firstfile.ini
secondfill.dll
thirdfile.exe
fourthfile.txt
fifthfile.jpg

id like my code to go through the filenames.txt file to search the c:\ drive for all names
contained in filenames.txt

'--------------------------------------------------------------------------------------

Option Explicit

Dim fso As New FileSystemObject   ' Add microsoft scripting runtime reference
Dim fld As Folder

Private Sub Command1_Click()
   
   Dim nDirs As Long, nFiles As Long, lSize As Currency
   Dim sDir As String, sSrchString As String
   
   sDir = "c:\"
   sSrchString = "vb.ini"   '  the variable
   
   Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
   
   lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
   
   MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
   MsgBox "Total Size = " & lSize & " bytes"

End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
      nFiles = nFiles + 1
      List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

'--------------------------------------------------------------------------------------



0
Comment
Question by:Jimmyx1000
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 7
14 Comments
 
LVL 2

Expert Comment

by:gimmeadrink
ID: 12156495
This works....


Option Explicit

Dim fso As New FileSystemObject   ' Add microsoft scripting runtime reference
Dim fld As Folder

Private Sub Command1_Click()
   
    Dim nDirs As Long, nFiles As Long, lSize As Currency
    Dim sDir As String, sSrchString As String
   
    Dim strInputFileName As String
   
    sDir = "c:\"
 
   
    strInputFileName = "C:\input.txt"
   
    Open strInputFileName For Input As #1
    Do While Not EOF(1)
        Line Input #1, sSrchString
   
        Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
       
        lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
       
        MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
        MsgBox "Total Size = " & lSize & " bytes"
   
    Loop
    Close #1
   
   

End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
      nFiles = nFiles + 1
      List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

'--------------------------------------------------------------------------------------

0
 
LVL 2

Expert Comment

by:gimmeadrink
ID: 12156524
I decided to write a different set of code in case you want to be consistant by using the FileSystemObject and TextStream to read the input file instead of the generic vb readfile stuff.


----------------------------------------

Dim fso As New FileSystemObject   ' Add microsoft scripting runtime reference
Dim fld As Folder
Const fsoForReading = 1

Private Sub Command1_Click()
   
    Dim nDirs As Long, nFiles As Long, lSize As Currency
    Dim sDir As String, sSrchString As String
   
    Dim strInputFileName As String
    Dim objTextStream As TextStream

   
    sDir = "c:\"
     
   
    strInputFileName = "C:\input.txt"
   
    Set objTextStream = fso.OpenTextFile(strInputFileName, fsoForReading)
   
    Do While Not objTextStream.AtEndOfStream
        sSrchString = objTextStream.ReadLine
   
        Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
       
        lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
       
        MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
        MsgBox "Total Size = " & lSize & " bytes"
   
    Loop
    Close #1
   
   

End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
      nFiles = nFiles + 1
      List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

'--------------------------------------------------------------------------------------




The key part is:

    strInputFileName = "C:\input.txt"
   
    ' Open the new text stream
    Set objTextStream = fso.OpenTextFile(strInputFileName, fsoForReading)
   
    ' whiles its not the end of the file:
    Do While Not objTextStream.AtEndOfStream
        ' get the filename to find
        sSrchString = objTextStream.ReadLine

        '''''''''''''''''''''''' your code here ''''''''''''''''''''''''

    ' finished with the file, loop and start again
    Loop


good luck
0
 
LVL 2

Expert Comment

by:gimmeadrink
ID: 12156549
oh, one more think.

strInputFileName = "C:\input.txt"


should have "C:\filenames.txt" or whatever the full path of the file that contains the list of files to search for.
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

Author Comment

by:Jimmyx1000
ID: 12157022
Would there be a chance that instead of having to search all the drive again
with each new file in the "C:\input.txt"

it would rather do a search like

eg.

code starts search at the begining of c:\ drive

the first file it finds is   (  firstfilefound.exe  )

firstfilefound.exe  >>>>>  check if this file is in 1st line of "C:\input.txt"
if yes save path and filename to a variable for later processing

then with the same firstfilefound.exe on drive c:
firstfilefound.exe  >>>>>  check if this file is in 2nd line of "C:\input.txt"
if yes save path and filename to a variable for later processing

then with the same firstfilefound.exe on drive c:
firstfilefound.exe  >>>>>  check if this file is in 3rd line of "C:\input.txt"
if yes save path and filename to a variable for later processing

once all filenames in "C:\input.txt" has been searched it would move to
secondfilefound.exe on c:\drive  >>>>>  check if this file is in 1st line of "C:\input.txt"

etc etc etc

Basically i would like to search the c: drive in the quickest possible manner

the "C:\input.txt" will contain a lot of files names for processing later on

i figure this is a fast way to do it.

thankyou experts

0
 
LVL 2

Expert Comment

by:gimmeadrink
ID: 12157583
oh, ok....

do this instead...


Dim fso As New FileSystemObject   ' Add microsoft scripting runtime reference
Dim fld As Folder
Const fsoForReading = 1

Private Sub Command1_Click()
   
    Dim nDirs As Long, nFiles As Long, lSize As Currency
    Dim sDir As String, sSrchString As String
   
    Dim strInputFileName As String
    Dim objTextStream As TextStream

   
    sDir = "c:\"
     
   
    strInputFileName = "C:\input.txt"
   
    Set objTextStream = fso.OpenTextFile(strInputFileName, fsoForReading)
   
    Do While Not objTextStream.AtEndOfStream
        sSrchString = sSrchString & ";" & objTextStream.ReadLine
   
    Loop

        Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
       
        lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
       
        MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
        MsgBox "Total Size = " & lSize & " bytes"


End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
   While Len(FileName) <> 0
      FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
      nFiles = nFiles + 1
      List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
      FileName = Dir()  ' Get next file
      DoEvents
   Wend
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

'--------------------------------------------------------------------------------------

basically, seperating the filenames by ; is how you can find multiple files

Is this what you are after?

0
 

Author Comment

by:Jimmyx1000
ID: 12158002
Seems to enumerate  the c:\  drive and also goes through the input.txt file
but does not seem to match anything

where can i implement:

if sSrchString =  files on hdd then
add to listbox
end if

thankyou expert



0
 

Author Comment

by:Jimmyx1000
ID: 12158010
that last part should have read:

if sSrchString =  files on hdd then
add to path and filename to a listbox
end if
0
 
LVL 2

Expert Comment

by:gimmeadrink
ID: 12158104
ill have a look at it tonight sometime, im pretty sure its right, but i didnt actually run the code. I know that windows find does use ; to seperate searches... i might have stuffed up the code somewhere.

Ill get back to u in about 4 hours... sorry for the delay soooo much work to do.
0
 

Author Comment

by:Jimmyx1000
ID: 12158641
Thankyou experts
0
 
LVL 2

Accepted Solution

by:
gimmeadrink earned 2000 total points
ID: 12159076
ok........

This searchs the filesystem only once, and finds all files specified in the input file:
------------------------------------

Dim fso As New FileSystemObject   ' Add microsoft scripting runtime reference
Dim fld As Folder
Const fsoForReading = 1

Private Sub Command1_Click()
   
    Dim nDirs As Long, nFiles As Long, lSize As Currency
    Dim sDir As String, sSrchString() As String
   
    Dim strInputFileName As String
    Dim objTextStream As TextStream

    Dim i As Integer
   
    sDir = "c:\"
     
   
    strInputFileName = "C:\input.txt"
   
    Set objTextStream = fso.OpenTextFile(strInputFileName, fsoForReading)
   

    ReDim Preserve sSrchString(i)
    Do While Not objTextStream.AtEndOfStream
        i = UBound(sSrchString) + 1
        ReDim Preserve sSrchString(i)
        sSrchString(i) = objTextStream.ReadLine
   
    Loop

    Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
       
    lSize = FindFile(sDir, sSrchString, nDirs, nFiles)
       
    MsgBox Str(nFiles) & " files found in" & Str(nDirs) & " directories", vbInformation
    MsgBox "Total Size = " & lSize & " bytes"


End Sub

Private Function FindFile(ByVal sFol As String, sFile() As String, nDirs As Long, nFiles As Long) As Currency
   Dim tFld As Folder, tFil As File, FileName As String
   
   On Error GoTo Catch
   Set fld = fso.GetFolder(sFol)
   For i = 1 To UBound(sFile)
        FileName = Dir(fso.BuildPath(fld.Path, sFile(i)), vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
        While Len(FileName) <> 0
           FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName))
           nFiles = nFiles + 1
           List1.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
           FileName = Dir()  ' Get next file
           DoEvents
        Wend
   Next i
   Label1 = "Searching " & vbCrLf & fld.Path & "..."
   nDirs = nDirs + 1
   If fld.SubFolders.Count > 0 Then
      For Each tFld In fld.SubFolders
         DoEvents
         FindFile = FindFile + FindFile(tFld.Path, sFile, nDirs, nFiles)
      Next
   End If
   Exit Function
Catch:  FileName = ""
       Resume Next
End Function

------------------------------------


Im sure this is it....

Comments?
0
 

Author Comment

by:Jimmyx1000
ID: 12163847
Congratulations my friend you done it

your code works as i want it too.

Thankyou very much for your time and effort.  

Thanks.

Id love to add an extra 500 points if you can do me a
pause button and a stop button.



0
 

Author Comment

by:Jimmyx1000
ID: 12164030
Hmmmmm  seems very slow on a large "c:\input.txt"

any suggestions.
0
 
LVL 2

Expert Comment

by:gimmeadrink
ID: 12164582
Ok, i have a couple ideas for both, ill have to get back to you late tonight tho (its GMT+10 here... gotta go to work now)

Thanks a lot for the points and the A
0
 

Author Comment

by:Jimmyx1000
ID: 12164673
Really appreciate the help Mr. Expert

Good Work

Look forward to the results

thanks Expert


0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

618 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