Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Trupti Patil   on Nov 27 In MS Office Category.

  
Question Answered By: Xander Thompson   on Nov 27

I've found a much quicker method:

--------

Sub FindFiles()

Dim Files() As String, stFolder As String, stFiles As String
Dim i As Long

ReDim Files(1 To 1)

stFolder = " "Folder name" "

stFiles = "*" & ActiveCell.EntireRow.Cells(1, 1).Value & "*"

If FindFile(stFolder, stFiles, Files, True) Then
For i = 1 To UBound(Files)
UserForm1.ListBox1.AddItem Files(i)
Next i
End If

End Sub

---------

Function FindFile(stFolder As String, stFil As String, stFilArray() As
String, blSubfolder As Boolean) As Boolean

Dim fsoObj As Scripting.FileSystemObject
Dim fsoFolder As Scripting.Folder
Dim fsoSubFolder As Scripting.Folder
Dim stFileName As String

Set fsoObj = New Scripting.FileSystemObject

If fsoObj.FolderExists(stFolder) Then
Set fsoFolder = fsoObj.GetFolder(stFolder)
Else
MsgBox "Cannot find folder!"
FindFile = False
Exit Function
End If

stFileName = Dir(fsoObj.BuildPath(stFolder, stFil))
If stFilArray(1) = "" Then
stFilArray(1) = stFolder & "\" & stFileName
Else
ReDim Preserve stFilArray(1 To UBound(stFilArray) + 1)
stFilArray(UBound(stFilArray)) = stFileName
End If

Do While stFileName <> ""
stFileName = fsoObj.BuildPath(stFolder, stFileName)
stFileName = Dir()
If stFileName = "" Then
Exit Do
Else
ReDim Preserve stFilArray(1 To UBound(stFilArray) + 1)
stFilArray(UBound(stFilArray)) = stFolder & "\" & stFileName
End If
Loop

'If extend to search subfolders
If blSubfolder Then
For Each fsoSubFolder In fsoFolder.SubFolders
FindFile fsoSubFolder.Path, stFil, stFilArray, True
Next
End If

FindFile = True

Set fsoSubFolder = Nothing
Set fsoFolder = Nothing
Set fsoObj = Nothing

End Function

Share: 

 

This Question has 2 more answer(s). View Complete Question Thread

 
Didn't find what you were looking for? Find more on Loop through folders Or get search suggestion and latest updates.


Tagged: