View Full Version : [SOLVED:] Search worksheets in folder and sub folders
gibbo1715
08-28-2005, 05:12 AM
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
mdmackillop
08-28-2005, 05:19 AM
Hi Gibbo,
Have a look at this KB Item
http://vbaexpress.com/kb/getarticle.php?kb_id=245
gibbo1715
08-28-2005, 05:37 AM
Thanks, that looks like a good place to start
Gibbo
Norie
08-28-2005, 06:48 AM
Why not use the FileSearch object where you can specify to search sub folders?
gibbo1715
08-28-2005, 06:51 AM
Norie, can you post an example for me
cheers
gibbo
Norie
08-28-2005, 07:48 AM
Straight from VBA Help.
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
gibbo1715
08-28-2005, 08:23 AM
nice short method i hadnt seen before, thanks i ll have a play with it and see what i come up with
Gibbo
gibbo1715
08-28-2005, 09:12 AM
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?
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
Cheers
Gibbo
Norie
08-28-2005, 09:46 AM
I can't see why that code would cause that problem.
gibbo1715
08-28-2005, 09:48 AM
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
gibbo1715
08-28-2005, 10:04 AM
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?
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Savename
Application.DisplayAlerts = True
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?
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
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.:devil:
gibbo1715
08-28-2005, 10:33 AM
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
Justinlabenne
08-28-2005, 02:55 PM
How many files are being found?
Can you attach a sample in this thread? Cannot seem to duplicate the error here.
Bob Phillips
08-29-2005, 05:38 AM
Here is a different way, using FSO instead of the flaky FileSearch. It also
searches down into sub-folders and indents the levels.
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
gibbo1715
08-29-2005, 05:43 AM
i ll have a try when i get near my own computer
Thanks for taking the trouble to reply
Gibbo
Bob Phillips
08-29-2005, 05:44 AM
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 how to do that, so I just gave an example of recursion using FSO.
gibbo1715
08-29-2005, 05:48 AM
Thanks again
Gibbo
gibbo1715
08-30-2005, 07:32 AM
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?
gibbo1715
08-30-2005, 07:57 AM
figured out it needs a ref to msfile scripting object, and changed the line
Set FSO = CreateObject("SCripting.FileSy*stemObject")
to
Set FSO = CreateObject("Scripting.FileSystemObject")
then works fine
Cheers Gibbo
Bob Phillips
08-30-2005, 08:16 AM
figured out it needs a ref to msfile scripting object, and changed the line
Set FSO = CreateObject("SCripting.FileSy*stemObject")
to
Set FSO = CreateObject("Scripting.FileSystemObject")
then works fine
Glad you got it to work, don't know where that * came from.
BUTyou don't need to set a reference, my code is late binding.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.