PDA

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

MWE
08-28-2005, 10:22 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
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.