PDA

View Full Version : [SOLVED] FileSearch Macro error



megha
04-04-2014, 10:11 AM
I have very old written macro to pull file names from one particular folder. It was working great like a magic. Today I am getting error message "Run time error 445: Object doesn't support this action" when I tried to run it. I double check the path and its correct. Not sure what is going wrong. Can someone please help?

Here is the code I am using:

BTW, i have a completed checklist folder where everyone housekeeping reports are saving on monthy basis. so, I use Month and year in cell E4 (i.e. Mar_2014) to run this script.



Private Sub CommandButton1_Click()
Dim fs As FileSearch, ws As Worksheet, i As Long
Set fs = Application.FileSearch
With fs
.SearchSubFolders = False ' set to true if you want sub-folders included
.FileType = msoFileTypeAllFiles 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks
.LookIn = "\\sptd.sabert.net/sites/op/olt/Production Supervisors/HouseKeeping/Completed_Checklist\" & Range("E4").Value 'modify this to where you want to serach
If .Execute > 0 Then
Set ws = Worksheets.Add
For i = 1 To .FoundFiles.Count
ws.Cells(i, 1) = Mid$(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)
Next
Else
MsgBox "No files found"
End If
End With
End Sub

Kenneth Hobs
04-04-2014, 12:30 PM
FileSearch was removed in 2007. What version are you using?

Simon Lloyd
04-04-2014, 01:27 PM
Here's a tutorial on using the File System Object http://www.thecodecage.com/forumz/view.php?pg=filesystemobject

Kenneth Hobs
04-04-2014, 01:51 PM
There are at least 4 methods that I use for that sort of thing. Dir() is an easy one if you don't need to iterate subfolders.
e.g.

Sub DirFiles()
Dim FileName As String, FileSpec As String, FileFolder As String
Dim wb As Workbook

FileFolder = ThisWorkbook.Path & "\"
FileSpec = FileFolder & "*.xlsm"

FileName = Dir(FileSpec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
If IsWorkbookOpen(FileName) = False Then
'Set wb = Workbooks.Open(FileFolder & FileName)
'DoEvents
'wb.Close True
Debug.Print FileName
End If
FileName = Dir()
Loop

End Sub


Function IsWorkbookOpen(stName As String) As Boolean
Dim Wkb As Workbook
On Error Resume Next ' In Case it isn't Open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then IsWorkbookOpen = True
'Boolean Function assumed To be False unless Set To True
End Function


Similarly:

'http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
Sub Test_GetFileList()
Dim p As String, x As Variant, i As Integer

p = ThisWorkbook.Path & "/*.xls"
x = GetFileList(p)
Select Case IsArray(x)
Case True 'files found
MsgBox UBound(x), , "Count of Found Files"
Sheets("Sheet1").Range("A:A").Clear
For i = LBound(x) To UBound(x)
Sheets("Sheet1").Cells(i, 1).Value = x(i)
Next i
Case False 'no files found
MsgBox "No matching files"
End Select
End Sub

Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String

On Error GoTo NoFilesFound

FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound

' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function

' Error handler
NoFilesFound:
GetFileList = False
End Function

For the more robust FSO method:

'http://www.ozgrid.com/forum/showthread.php?t=157939
Sub Test_SearchFiles()
Dim v As Variant, a() As Variant
SearchFiles ThisWorkbook.Path, "*.xls", 0, a(), True
For Each v In a()
Debug.Print v
Next v
End Sub


Private Function SearchFiles(myDir As String _
, myFileName As String, n As Long, myList() _
, Optional SearchSub As Boolean = False) As Variant
Dim fso As Object, myFolder As Object, myFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each myFile In fso.getfolder(myDir).Files
Select Case myFile.Attributes
Case 2, 4, 6, 34
Case Else
If (Not myFile.Name Like "~$*") _
* (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
* (UCase(myFile.Name) Like UCase(myFileName)) Then
n = n + 1
ReDim Preserve myList(1 To 2, 1 To n)
myList(1, n) = myDir
myList(2, n) = myFile.Name
End If
End Select
Next
If SearchSub Then
For Each myFolder In fso.getfolder(myDir).subfolders
SearchFiles = SearchFiles(myFolder.Path, myFileName, _
n, myList, SearchSub)
Next
End If
SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function


The 3rd method would use a Class and it would be used similar to the FileSearch method. Most find the two methods above sufficient. The advantage to the 3rd method is that you don't have to change alot of code built already. If this interests you see:

'ginismo, http://www.mrexcel.com/forum/showthread.php?t=369982 'Class method
'http://www.mrexcel.com/forum/showthread.php?p=1839452
'http://www.4shared.com/file/87591234/8d1d705d/1839452_classFileSearch_and_Excel4.html
'http://www.mrexcel.com/forum/showthread.php?p=2551004 'alternate class method
'http://dl.dropbox.com/u/35239054/FileSearch.cls 'alternate class method by Andreas Killer, version 1.43

megha
04-08-2014, 12:49 PM
I am using 2010. I am not an expert with VBA coding. Can you please help modifying my existing code? I have include the code in my original post, Thank you so much!

Kenneth Hobs
04-08-2014, 12:56 PM
Then you have your answer as to why it does not "work great" now. I gave you several ways to solve the problem now.

megha
04-08-2014, 01:10 PM
Where do I insert my path on this code?

Kenneth Hobs
04-08-2014, 01:47 PM
FileFolder = ThisWorkbook.Path & "\"

megha
04-10-2014, 07:46 AM
First of all Thank you so much for your help. Forgive my inexperience, I included the path and trying with the first code but nothing happens when I click the button. Can you please take a quick look at the code below and advise, Thank you so much.


Private Sub DirFiles_Click()
Dim FileName As String, FileSpec As String, FileFolder As String
Dim wb As Workbook

FileFolder = ThisWorkbook.Path & ""\\sptd.sabert.net/sites/op/olt/Production Supervisors/HouseKeeping/Completed_Checklist\" & Range("E4").Value
FileSpec = FileFolder & "*.xlsm"

FileName = Dir(FileSpec)
If FileName = "" Then Exit Sub

' Loop until no more matching files are found
Do While FileName <> ""
If IsWorkbookOpen(FileName) = False Then
'Set wb = Workbooks.Open(FileFolder & FileName)
'DoEvents
'wb.Close True
Debug.Print FileName
End If
FileName = Dir()
Loop
End Sub
Function IsWorkbookOpen(stName As String) As Boolean
Dim Wkb As Workbook
On Error Resume Next ' In Case it isn't Open
Set Wkb = Workbooks(stName)
If Not Wkb Is Nothing Then IsWorkbookOpen = True
'Boolean Function assumed To be False unless Set To True
End Function

Kenneth Hobs
04-10-2014, 07:57 AM
The value for your FileFolder path makes no sense to me. Why are you adding ThisWorkbook.Path to your folder's path?

Are you working from a sharepoint site? I don't know that file/folder paths would work for such. If it did work, then something like:

FileFolder = "\\sptd.sabert.net/sites/op/olt/Production Supervisors/HouseKeeping/Completed_Checklist\" & Range("E4").Value2 & "\"

megha
04-10-2014, 08:25 AM
no luck! Yes i have all files on sharepoint site. My old macro for 2003 used to look in for file names on given Sharepoint Path then added the list on file with new work sheet. On SharePoint site i have a folder by month where all reports stored.

Kenneth Hobs
04-10-2014, 08:52 AM
The fso method will work with Sharepoint, Dir() will not. Another point, you might want to be consistent and use all backslash character delimiters for the paths. http://stackoverflow.com/questions/1344910/get-the-content-of-a-sharepoint-folder-with-excel-vba

In my fso example, you can test like this:

Sub Test_SearchFiles()
Dim v As Variant, a() As Variant, FileFolder As String
FileFolder = "\\sptd.sabert.net\sites\op\olt\Production Supervisors\HouseKeeping\Completed_Checklist\" & Range("E4").Value2 & "\"
'FileFolder = ThisWorkbook.Path
SearchFiles FileFolder, "*.xls", 0, a(), True
'Debug.Print UBound(a(), 1), UBound(a(), 2)
For Each v In a()
Debug.Print v
Next v
End Sub

' Returns 2 dimension array. e.g. a(1,1)=Path, a(2,1)=Filename
Private Function SearchFiles(myDir As String _
, myFileName As String, n As Long, myList() _
, Optional SearchSub As Boolean = False) As Variant
Dim fso As Object, myFolder As Object, myFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each myFile In fso.getfolder(myDir).Files
Select Case myFile.Attributes
Case 2, 4, 6, 34
Case Else
If (Not myFile.Name Like "~$*") _
* (myFile.Path & "\" & myFile.Name <> ThisWorkbook.FullName) _
* (UCase(myFile.Name) Like UCase(myFileName)) Then
n = n + 1
ReDim Preserve myList(1 To 2, 1 To n)
myList(1, n) = myDir
myList(2, n) = myFile.Name
End If
End Select
Next
If SearchSub Then
For Each myFolder In fso.getfolder(myDir).subfolders
SearchFiles = SearchFiles(myFolder.Path, myFileName, _
n, myList, SearchSub)
Next
End If
SearchFiles = IIf(n > 0, myList, CVErr(xlErrRef))
End Function