FileSearch Macro error

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.

Code:

---

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

---

FileSearch was removed in 2007. What version are you using?

Here's a tutorial on using the File System Object http://www.thecodecage.com/forumz/vi...lesystemobject

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.

Code:

---

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:

Code:

---

'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:

Code:

---

'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

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!

Then you have your answer as to why it does not "work great" now. I gave you several ways to solve the problem now.

Where do I insert my path on this code?

Quote:

---

FileFolder = ThisWorkbook.Path & "\"

---

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.

Code:

---

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

---

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:

Code:

---

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

---

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.

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/1...with-excel-vba

In my fso example, you can test like this:

Code:

---

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

---