FileSearch VBA error - please help!

[megha]

Hello, I have following code to search for files from given path. My purpose is to get the list of the "file names" from specified folder (i.e. Mar_2014 or Jan_204) on blank worksheet when I click the command button that has a macro with the path where all files have been stored by month. The following script giving me error and due to my inexperience I am totally blank what need to be done next to make this work. I would appriciate any help, Thank you so much in advance.

the following script is on my "module:"

Function CheckPath(strPath As String) As Boolean
    If Dir$(strPath) <> "" Then
        CheckPath = True
    Else
        CheckPath = False
    End If
End Function

and I have this script on my "sheet 1:"

Private Sub commandbutton1_Click()
Dim FileFolder As String
    FileFolder = "\\sptdsrefining.sabert.net/sites/ProductionSupervisors/HouseKeeping/Completed_Checklist\" & Range("E4").Value
    If CheckPath(FileFolder) = True Then
        'Path exists, do what you want here
        ws As Worksheet, i As Long
        Set ws = Worksheets.Add
           For i = 1 To .FoundFiles.Count
               ws.Cells(i, 1) = Mid$(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)
            Next
    Else
        'Path does not exist, do what you want here
         MsgBox "No files found"
    End If
End Sub

[Kenneth Hobs]

You have many issues there.

1. Dir() is for local files, not web files or sharepoint files.
2. Where is the With for the .FoundFiles.Count? If you are using the FileSearch() method in Excel versions 2007+, that only works for 2003-.
3. Use FSO methods to accomplish your goals.

I already explained this to you in your thread: http://www.vbaexpress.com/forum/showthread.php?49366

[megha]

Thank you so much for your help. Yes, i tired this FSO method earlier but nothing happens. I might be doing something wrong. Where am i suppose to paste this code? I would like to use it as a "Command button" if possible. Can i do that? If i use it on command button then what lines need to be changed from this script? First line only?

[Kenneth Hobs]

Where the code is located depends on the kind of command button, forms or activex control. Posting a short sample workbook would help me help you better. You can manually add the new sheet with the output expected.

In any case, one typically puts Functions into a Module.

Why don't you test the code as I suggested to see if it will get what you need? Putting the result in column A of a new sheet is trivial. I can show that to you later.

Put all of this in a Module. Then run the Test sub. Of course you need to run it with the sheet active that has the correct value of cell E4. After you run it, review VBE's Immediate Window for the results of Debug.Print.

You may need to change the Value2 to Text if E4 is formatted date. I put the result of FileFolder into the Immediate window with Debug.Print so you can check if the FileFolder string was correct.

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 & "\" 
     Debug.Print "FileFolder = ", FileFolder
     'FileFolder = ThisWorkbook.Path
    SearchFiles FileFolder, "*.*", 0, a(), False
     '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
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

[megha]

I pasted the code on module. Nothing happens when I run the macro. Please see attached file, Thank you!

[Kenneth Hobs]

I really doubt that "nothing happens". Did you not check the Immediate window? Did it not error out if it could not find the site's folder?

Replace your Module's code with:

Sub Test_SearchFiles()
    Dim v As Variant, a() As Variant, FileFolder As String, b() As Variant
    FileFolder = "\\sptd.sabert.net\sites\op\olt\Production Supervisors\HouseKeeping\Completed_Checklist\" & Range("E4").Value2 & "\"
    'FileFolder = ThisWorkbook.Path
    SearchFiles FileFolder, "*.*", 0, a(), False
    
    If ArrayIsNotEmpty(a) = False Then
      MsgBox "Array a() is empty.", vbCritical, "No Files Found"
      Exit Sub
    End If
    
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    b() = SearchFilesE2(a())
    Range("A1").Resize(UBound(b)) = WorksheetFunction.Transpose(b)
End Sub
 
 ' Returns 2 dimension array.  e.g. a(1,1)=Path, a(2,1)=Filename
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")
    On Error GoTo EndNow
    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))
EndNow:
End Function

' Return 2nd dimension of array as 1 dimensional array
Function SearchFilesE2(anArray() As Variant) As Variant
  Dim a1() As Variant, i As Integer
  On Error GoTo EndNow
  ReDim a1(1 To UBound(anArray, 2))
  For i = 1 To UBound(anArray, 2)
    a1(i) = anArray(2, i)
  Next i
  SearchFilesE2 = a1()
EndNow:
End Function

'Mikerickson, http://www.mrexcel.com/forum/showthread.php?p=1709702
Function ArrayIsNotEmpty(anyArray As Variant) As Boolean
    On Error Resume Next
        ArrayIsNotEmpty = IsNumeric(VarPtr(Array(LBound(anyArray))))
    On Error GoTo 0
End Function

For the activex command button's code on that sheet, simply add this code. Tip: Open the Developer's ribbon and select the Design Mode button and double click the button to get the click event to open. Otherwise, right click the sheet's tab, View Code, paste.

Private Sub commandbutton1_Click()
  Test_SearchFiles
End Sub

[megha]

Thak you! Thank you! Thank you! This is working like a magic once again! Thank you so much for all your help!!

[megha]

This was working fine when I test it few hours ago. Now I am getting error message, " Array a() is empty." What do i have to do now? Can you please help? Do you want me to attach the file?

[Kenneth Hobs]

That means that the folder does not exist or no files were in that folder. Check manually to verify one of those scenarios. You might want to create a validation list to insure that proper subfolder names are selected.

[megha]

The folder is there with the files. I manually verified it. I am doing for the same folder I have done while testing this.

[megha]

Do I need to create a validation list? Why is not working now? It worked when I was testing this. I was testing this for the same Mar_2014 and Apr_2014 folders and added the results on new sheets. Now its saying the folder is empty.

[Kenneth Hobs]

Networking can go down or firewalls can block things. To see if you have the proper string for filefolder, do the Debug.Print FileFolder after the value for FileFolder was set. After running that code, in the immediate window, copy that string. Paste in into a Win+R window. That folder should open if it exits and all things sharepoint are working right.

[megha]

I apologies - it just realized my mistake. It was due to incorrect path. Thanks for your help!

[megha]

Hello Mr. Hobs, I have a quick question on this script. How do i use this macro for 4 more different path? As of now I have this code for Commandbutton1. I would like to have 4 more same code with different paths with four different command buttons. I know how to insert the commandbutton and add code for it. The only issue is how do i make it for four different paths that work with four different commandbutton? Do I have to copy and paste this script four times on module with appropriate path and work with commandbotton the way we have done for commandbutton one? if yes, does all of them stay on one modules or do i have to use other modules? or is there any other way? Thank you.