Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 21

Thread: Solved: search worksheets in folder and sub folders

  1. #1
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location

    Solved: search worksheets in folder and sub folders

    Another question for you

    I can search all workbooks within a directory, is there a way to also search all sub directories or is this not possible?

    Cheers

    Gibbo

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Gibbo,
    Have a look at this KB Item
    http://vbaexpress.com/kb/getarticle.php?kb_id=245
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    Thanks, that looks like a good place to start

    Gibbo

  4. #4
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    Why not use the FileSearch object where you can specify to search sub folders?

  5. #5
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    Norie, can you post an example for me

    cheers

    gibbo

  6. #6
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    Straight from VBA Help.
    [vba]
    With Application.FileSearch
    .NewSearch
    .LookIn = "C:\My Documents"
    .SearchSubFolders = True
    .FileType = msoFileTypeAllFiles
    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[/vba]

  7. #7
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    nice short method i hadnt seen before, thanks i ll have a play with it and see what i come up with

    Gibbo

  8. #8
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    Ok ended up with the code below which works fine until i try and save the workbook having run the search, excel then crashes, anyone got any idea why?

    [VBA] Sub FindTextString()
    Dim i As Integer
    Dim szSearchWord As Variant

    szSearchWord = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
    If szSearchWord = False Then
    Sheets("Sheet1").Select
    End
    End If
    With Application.FileSearch
    .NewSearch
    .LookIn = ThisWorkbook.Path
    .FileType = msoFileTypeAllFiles
    .SearchSubFolders = True
    .TextOrProperty = szSearchWord
    .Execute
    MsgBox "There were " & .FoundFiles.Count & " file(s) found."
    For i = 1 To .FoundFiles.Count
    ActiveSheet.Range("b" & (i + 1)) = .FoundFiles(i) 'FoundFiles(i) 'Mid(.FoundFiles(i), _
    'InStrRev(.FoundFiles(i), "\") + 1)
    Next i

    End With

    Exit Sub

    End Sub [/VBA]

    Cheers

    Gibbo

  9. #9
    VBAX Master Norie's Avatar
    Joined
    Jan 2005
    Location
    Stirling, Scotland
    Posts
    1,831
    Location
    I can't see why that code would cause that problem.

  10. #10
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    nor me, thats why im confused (Well more than normal anyway !!!)

    Edit

    I left it for a bit and came back to a message box - save not completed. File rename failed. retry?

    Thats a new one on me,

    Any Ideas

    Gibbo

  11. #11
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    I added the below to the end which solves my problem but i dont really want to save my workbook at this point, any ideas?

    [VBA] Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Savename
    Application.DisplayAlerts = True [/VBA]

  12. #12
    VBAX Expert
    Joined
    Feb 2005
    Posts
    929
    Location
    Quote Originally Posted by gibbo1715
    Ok ended up with the code below which works fine until i try and save the workbook having run the search, excel then crashes, anyone got any idea why?

    [VBA] Sub FindTextString()
    Dim i As Integer
    Dim szSearchWord As Variant

    szSearchWord = Application.InputBox("What are you looking for ?", "Search", , 100, 100, , , 2)
    If szSearchWord = False Then
    Sheets("Sheet1").Select
    End
    End If
    With Application.FileSearch
    .NewSearch
    .LookIn = ThisWorkbook.Path
    .FileType = msoFileTypeAllFiles
    .SearchSubFolders = True
    .TextOrProperty = szSearchWord
    .Execute
    MsgBox "There were " & .FoundFiles.Count & " file(s) found."
    For i = 1 To .FoundFiles.Count
    ActiveSheet.Range("b" & (i + 1)) = .FoundFiles(i) 'FoundFiles(i) 'Mid(.FoundFiles(i), _
    'InStrRev(.FoundFiles(i), "\") + 1)
    Next i

    End With

    Exit Sub

    End Sub [/VBA]

    Cheers

    Gibbo
    it may not be the code, but rather the combination of the code and the version of Excel and op/sys you are running. Some of these things are obvious due to new features or not-supported features. But some are not so obvious: I have code that runs flawlessly on computer A and is flakey on computer B. Both are running Excel2K but one has Win2K and the other WinXP. Also, I have noticed some differences in how Excel runs on WinXP/SP1 vs WinXP/SP2. For example, VBA help worked fine running Office2K under Win2K. VBA help never worked running the same Office2K under WinXP/SP1. But that same Office2K VBA Help works fine under WinXP/SP2.

    Somewhere in the "how to get help" stickies there is something about clearly indicating computer, op/sys and MS appl version. We all forget at times.
    "It's not just the due date that's important, it's also the do date" [MWE]

    When your problem has been resolved, mark the thread SOLVED by clicking on the Thread Tools dropdown menu at the top of the thread.

  13. #13
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    that sounds about right, im running office 2000 on win xp home edition.

    Is there a way to do a save as without actually saving (If that makes any sense!!!!!)

    i.e. trick excel into thinking the spreadsheet is saved where it should be again

  14. #14
    VBAX Mentor Justinlabenne's Avatar
    Joined
    Jul 2004
    Location
    Clyde, Ohio
    Posts
    408
    Location
    How many files are being found?

    Can you attach a sample in this thread? Cannot seem to duplicate the error here.
    Justin Labenne

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,232
    Location
    Here is a different way, using FSO instead of the flaky FileSearch. It also
    searches down into sub-folders and indents the levels.

    [VBA]Option Explicit

    Private cnt As Long
    Private arfiles
    Private level As Long

    Sub Folders()
    Dim i As Long
    Dim sFolder As String
    Dim iStart As Long
    Dim iEnd As Long
    Dim fOutline As Boolean

    arfiles = Array()
    cnt = -1
    level = 1

    sFolder = "E:\"
    ReDim arfiles(2, 0)
    If sFolder <> "" Then
    SelectFiles sFolder
    Application.DisplayAlerts = False
    On Error Resume Next
    Worksheets("Files").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Worksheets.Add.Name = "Files"
    With ActiveSheet
    For i = LBound(arfiles, 2) To UBound(arfiles, 2)
    If arfiles(0, i) = "" Then
    If fOutline Then
    Rows(iStart + 1 & ":" & iEnd).Rows.Group
    End If
    With .Cells(i + 1, arfiles(2, i))
    .Value = arfiles(1, i)
    .Font.Bold = True
    End With
    iStart = i + 1
    iEnd = iStart
    fOutline = False
    Else
    .Hyperlinks.Add Anchor:=.Cells(i + 1, arfiles(2, i)), _
    Address:=arfiles(0, i), _
    TextToDisplay:=arfiles(1, i)
    iEnd = iEnd + 1
    fOutline = True
    End If
    Next
    .Columns("A:Z").ColumnWidth = 5
    End With
    End If
    'just in case there is another set to group
    If fOutline Then
    Rows(iStart + 1 & ":" & iEnd).Rows.Group
    End If

    Columns("A:Z").ColumnWidth = 5
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    ActiveWindow.DisplayGridlines = False

    End Sub


    '-----------------------------*------------------------------*------------
    Sub SelectFiles(Optional sPath As String)
    '-----------------------------*------------------------------*------------
    Static FSO As Object
    Dim oSubFolder As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim oFiles As Object
    Dim arPath

    If FSO Is Nothing Then
    Set FSO = CreateObject("SCripting.FileSy*stemObject")
    End If

    If sPath = "" Then
    sPath = CurDir
    End If

    arPath = Split(sPath, "\")
    cnt = cnt + 1
    ReDim Preserve arfiles(2, cnt)
    arfiles(0, cnt) = ""
    arfiles(1, cnt) = arPath(level - 1)
    arfiles(2, cnt) = level

    Set oFolder = FSO.GetFolder(sPath)
    Set oFiles = oFolder.Files
    For Each oFile In oFiles
    cnt = cnt + 1
    ReDim Preserve arfiles(2, cnt)
    arfiles(0, cnt) = oFolder.Path & "\" & oFile.Name
    arfiles(1, cnt) = oFile.Name
    arfiles(2, cnt) = level + 1
    Next oFile

    level = level + 1
    For Each oSubFolder In oFolder.Subfolders
    SelectFiles oSubFolder.Path
    Next
    level = level - 1

    End Sub


    #If VBA6 Then
    #Else
    '-----------------------------***----------------------------*-*-*------
    Function Split(Text As String, _
    Optional Delimiter As String = ",") As Variant
    '-----------------------------***----------------------------*-*-*------
    Dim i As Long
    Dim sFormula As String
    Dim aryEval
    Dim aryValues

    If Delimiter = vbNullChar Then
    Delimiter = Chr(7)
    Text = Replace(Text, vbNullChar, Delimiter)
    End If

    sFormula = "{""" & Application.Substitute(Text, Delimiter, """,""") & """}"
    aryEval = Evaluate(sFormula)
    ReDim aryValues(0 To UBound(aryEval) - 1)
    For i = 0 To UBound(aryValues)
    aryValues(i) = aryEval(i + 1)
    Next

    Split = aryValues

    End Function


    '-----------------------------*------------------------------*----------------
    Public Function InStrRev(stringcheck As String, _
    ByVal stringmatch As String, _
    Optional ByVal start As Long = -1)
    '-----------------------------*------------------------------*----------------
    Dim iStart As Long
    Dim iLen As Long
    Dim i As Long

    If iStart = -1 Then
    iStart = Len(stringcheck)
    Else
    iStart = start
    End If

    iLen = Len(stringmatch)

    For i = iStart To 1 Step -1
    If Mid(stringcheck, i, iLen) = stringmatch Then
    InStrRev = i
    Exit Function
    End If
    Next i
    InStrRev = 0
    End Function
    '-----------------------------*------------------------------*------
    #End If
    [/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  16. #16
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    i ll have a try when i get near my own computer

    Thanks for taking the trouble to reply

    Gibbo

  17. #17
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,232
    Location
    Quote Originally Posted by gibbo1715
    i ll have a try when i get near my own computer

    Thanks for taking the trouble to reply

    Gibbo
    It doesn't do the search, it just links all the files in a worksheet, but you said you know haow to do that, so I just gave an example of recursion using FSO.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  18. #18
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    Thanks again

    Gibbo

  19. #19
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    i get an error at Set FSO = CreateObject("Scripting.FileSy*stemObject"), is this because i need to set up a refernece, and if so what to?

  20. #20
    VBAX Expert
    Joined
    Jan 2005
    Posts
    574
    Location
    figured out it needs a ref to msfile scripting object, and changed the line
    [VBA]
    Set FSO = CreateObject("SCripting.FileSy*stemObject") 'to

    Set FSO = CreateObject("Scripting.FileSystemObject") [/VBA]

    then works fine


    Cheers Gibbo

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •