?
Solved

File Searches

Posted on 1999-12-13
9
Medium Priority
?
180 Views
Last Modified: 2010-05-02
I need to search several directories, most having MANY sub-directories themselves, for a particular user-supplied file name.  I am familiar with the DIR function and know I could accomplish my task using it, but it would require a lot of juggling since you can't use the DIR function within a DIR loop.  Is there some way to provide a starting path and a file name, and have it traverse the sub-directories?
0
Comment
Question by:mhyohe
9 Comments
 

Author Comment

by:mhyohe
ID: 2277884
Edited text of question.
0
 
LVL 32

Expert Comment

by:Erick37
ID: 2277924
Microsoft's article wich can easily be modified to find a specific file:

"HOWTO: Search Directories to Find or List Files"

http://support.microsoft.com/support/kb/articles/Q185/4/76.ASP
0
 
LVL 32

Expert Comment

by:Erick37
ID: 2278032
Another one:

FindFile - Fast using the Windows API

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=1446
0
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
LVL 1

Expert Comment

by:davism
ID: 2278764
You can use the filesystemobject as well.

0
 
LVL 13

Expert Comment

by:crazyman
ID: 2279318
   Sub FilesSearch(DrivePath As String, Ext As String)


        Dim XDir() As String
        Dim TmpDir As String
        Dim FFound As String
        Dim DirCount As Integer
        Dim X As Integer
        'Initialises Variables
        DirCount = 0
        ReDim XDir(0) As String
        XDir(DirCount) = ""
        If Right(DrivePath, 1) <> "\" Then
            DrivePath = DrivePath & "\"
        End If
        'Enter here the code for showing the path being
        'search. Example: Form1.label2 = DrivePath
        'Search for all directories and store in the
        'XDir() variable
        DoEvents
            TmpDir = Dir(DrivePath, vbDirectory)
            Do While TmpDir <> ""
                On Error GoTo o
                If TmpDir <> "." And TmpDir <> ".." Then
                    If (GetAttr(DrivePath & TmpDir) And vbDirectory) = vbDirectory Then
                        XDir(DirCount) = DrivePath & TmpDir & "\"
                        DirCount = DirCount + 1
                        ReDim Preserve XDir(DirCount) As String
                    End If
                End If
                TmpDir = Dir
            Loop
            'Searches for the files given by extension Ext
            FFound = Dir(DrivePath & Ext)
            Do Until FFound = ""
                'Code in here for the actions of the files found.
                'Files found stored in the variable FFound.
                'Example: Form1.list1.AddItem DrivePath & FFound
                List1.AddItem DrivePath & FFound
                FFound = Dir
            Loop
            'Recursive searches through all sub directories
            For X = 0 To (UBound(XDir) - 1)
            If blnokay = True Then FilesSearch XDir(X), Ext
            Next X
Exit Sub
o:
Resume Next
        End Sub
0
 
LVL 10

Expert Comment

by:caraf_g
ID: 2279370
0
 
LVL 12

Expert Comment

by:mark2150
ID: 2279777
Of course you can cheat and shell to DOS momentarily...

SHELL( Environ("Comspec") & " /C DIR C:\" & FileName & " /S /B /-P /ON > C:\Result.Txt"), 1

Actually you'ld have to use ExecCmd instead of Shell to wait for the command to complete. But this is an easy 1 line solution...

M
 
0
 

Accepted Solution

by:
bja1 earned 400 total points
ID: 2279897
This is a great find file application,  it is NOT my code (and do not claim it as my own) and I got it off the net some time ago so I can't give you the address where I got it from.  If you want the actual project I can send it if you give your mail address.

'Form Code:
Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type BrowseInfo
    hWndOwner      As Long
    pIDLRoot       As Long
    pszDisplayName As Long
    lpszTitle      As Long
    ulFlags        As Long
    lpfnCallback   As Long
    lParam         As Long
    iImage         As Long
End Type

Public Function FindFilesAPI(path As String, SearchStr As String, _
    FileCount As Integer, DirCount As Integer)
    Dim FileName As String   ' Walking filename variable...
    Dim DirName As String    ' SubDirectory Name
    Dim dirNames() As String ' Buffer for directory name entries
    Dim nDir As Integer   ' Number of directories in this path
    Dim i As Integer      ' For-loop counter...
    Dim hSearch As Long   ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer

    If Right(path, 1) <> "\" Then path = path & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
            DirName = StripNulls(WFD.cFileName)
            ' Ignore the current and encompassing directories.
            If (DirName <> ".") And (DirName <> "..") Then
               ' Check for directory with bitwise comparison.
               If GetFileAttributes(path & DirName) And _
                FILE_ATTRIBUTE_DIRECTORY Then
                  dirNames(nDir) = DirName
                  DirCount = DirCount + 1
                  nDir = nDir + 1
                  ReDim Preserve dirNames(nDir)
               End If
            End If
            Cont = FindNextFile(hSearch, WFD)  ' Get next subdirectory.
         Loop
         Cont = FindClose(hSearch)
      End If

      ' Walk through this directory and sum file sizes.
      hSearch = FindFirstFile(path & SearchStr, WFD)
      Cont = True
      If hSearch <> INVALID_HANDLE_VALUE Then
         While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
               FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
                MAXDWORD) + WFD.nFileSizeLow
               FileCount = FileCount + 1
               List1.AddItem path & FileName
            End If
            Cont = FindNextFile(hSearch, WFD)  ' Get next file
         Wend
         Cont = FindClose(hSearch)
      End If

      ' If there are sub-directories...
      If nDir > 0 Then
         ' Recursively walk into them...
         For i = 0 To nDir - 1
           FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _
            & "\", SearchStr, FileCount, DirCount)
         Next i
    End If
End Function

Private Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
vbHourglass
        List1.Clear
        SearchPath = Text1.Text
        FindStr = Text2.Text
        FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
        Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _
        " Directories"
        Text4.Text = "Size of files found under " & SearchPath & " = " & _
        Format(FileSize, "#,###,###,##0") & " Bytes"
        Screen.MousePointer = vbDefault
    End Sub

Public Sub Browse()
    'Opens a Treeview control that displays the directories in a computer
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
    szTitle = "Please Choose a path"
    With tBrowseInfo
        .hWndOwner = Me.hWnd
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
    lpIDList = SHBrowseForFolder(tBrowseInfo)
    If (lpIDList) Then
    sBuffer = Space(MAX_PATH)
    SHGetPathFromIDList lpIDList, sBuffer
    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
    Text1.Text = sBuffer
End If
End Sub

Private Sub Command2_Click()
    Call Browse
End Sub


Private Sub Label2_Click()
    Text1.SetFocus
End Sub

Private Sub Label3_Click()
    Text2.SetFocus
End Sub


'ModuleCode:
Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Public Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function


0
 
LVL 32

Expert Comment

by:Erick37
ID: 2280535
Bjai:

The original source for your code can be found at the MS site which I listed in my first comment.
0

Featured Post

Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

Question has a verified solution.

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

When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

607 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