-
Maybe this will work for you. It may need some tweaks though for the same reasons that the other failed.
If you can send at least one subfolder rather than just the C: Drive, I think either will work fine for you.
[vba]Sub Test4()
Dim a() As String
a = ArrFiles("x:", "DropDownList1.xls", True)
MsgBox a(1, 1)
End Sub
'Similar to: NateO's code, http://www.mrexcel.com/forum/showpos...68&postcount=2
Function ArrFiles(strDir As String, searchTerm As String, _
Optional subFolders As Boolean = True)
Dim fso As Object
Dim strName As String
Dim i As Long
ReDim strArr(1 To Rows.Count, 1 To 1) As String
'strDir must not have a trailing \ for subFolders=True
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
'Exit if strDir does not exist
If Dir(strDir, vbDirectory) = "" Then Exit Function
Let strName = Dir$(strDir & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & strName
Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
'Strip trailing \ if subFolders=False
If subFolders = False Then strDir = Left(strDir, Len(strDir) - 1)
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
ArrFiles = strArr
End Function
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.subFolders
Let strName = Dir$(SubFolder.Path & "\" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "\" & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
End Sub[/vba]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules