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
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
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'
Thanks, that looks like a good place to start
Gibbo
Why not use the FileSearch object where you can specify to search sub folders?
Norie, can you post an example for me
cheers
gibbo
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
nice short method i hadnt seen before, thanks i ll have a play with it and see what i come up with
Gibbo
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?
CheersSub 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
Gibbo
I can't see why that code would cause that problem.
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
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
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.Originally Posted by gibbo1715
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.
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
How many files are being found?
Can you attach a sample in this thread? Cannot seem to duplicate the error here.
Justin Labenne
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
____________________________________________
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
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.Originally Posted by gibbo1715
____________________________________________
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
Thanks again
Gibbo
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?
figured out it needs a ref to msfile scripting object, and changed the line
toSet FSO = CreateObject("SCripting.FileSy*stemObject")
Set FSO = CreateObject("Scripting.FileSystemObject")
then works fine
Cheers Gibbo