Code for finding Workbooks

[brettvba]

Has anyone got any code for using the find files option (under the start menu search)to find excel files by a certain name say workbook.xls ?

_________________


I basically want this so if I send a file to someone it can find where their workbook is on their comp and perfom a few things is there another way to do this?




[ This Message was edited by: brettvba on 2002-05-05 19:47 ]

[brettvba]

Oh well i found some code which opens opens a file name found in any sub directory of the drives specified

does anyone have any tidyer code than this??

Function FilesFindMatching(sSearchPath As String, Optional sFileFilter As String = ".xls", Optional bSearchSubFolders As Boolean = False) As Variant
Dim lThisFile As Long, lFound As Long, asFiles() As String

With Application.FileSearch
'Initialise variables
.LookIn = sSearchPath
.Filename = sFileFilter
.SearchSubFolders = bSearchSubFolders
'Perform search
lFound = .Execute
If lFound Then
'Populate result array
ReDim asFiles(1 To lFound)
For lThisFile = 1 To lFound
asFiles(lThisFile) = .FoundFiles(lThisFile)
Next
'Return results
FilesFindMatching = asFiles
Else
'No matching files
FilesFindMatching = Empty
End If
End With
End Function




Sub FindBook()
Dim book
Dim avFiles As Variant, lThisFile As Long
avFiles = FilesFindMatching("c:", "Book1.xls", True)
If IsEmpty(avFiles) = True Then avFiles = FilesFindMatching("p:", "Book1.xls", True)
If IsEmpty(avFiles) = False Then
With ActiveSheet
.Range(.Cells(1), .Cells(UBound(avFiles), 1)).Value = Application.WorksheetFunction.Transpose(avFiles)
End With
book = Range("a1").Value
Workbooks.Open Filename:=(book)
Else
End If
End Sub