PDA

View Full Version : [SOLVED] FileSearch VBA error - please help!



megha
05-02-2014, 08:52 AM
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
05-02-2014, 09:32 AM
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
05-06-2014, 07:15 AM
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
05-06-2014, 08:16 AM
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
05-06-2014, 09:24 AM
I pasted the code on module. Nothing happens when I run the macro. Please see attached file, Thank you!

Kenneth Hobs
05-06-2014, 09:45 AM
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
05-06-2014, 10:58 AM
Thak you! Thank you! Thank you! This is working like a magic once again! Thank you so much for all your help!!

megha
05-06-2014, 01:31 PM
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
05-06-2014, 01:35 PM
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
05-06-2014, 01:38 PM
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
05-06-2014, 01:55 PM
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
05-06-2014, 02:03 PM
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
05-06-2014, 02:16 PM
I apologies - it just realized my mistake. It was due to incorrect path. Thanks for your help!

megha
05-09-2014, 01:48 PM
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.