Another Application.FileSearch replacement question

[redgreenrider]

I'm trying to fix some code written by someone else long ago. It makes use of application.filesearch to populate a few arrays and place the information in some listboxes. I've read many post on replacing the application.filesearch, but have not had any luck figuring this out. Any help would be greatly appreciated.

Option Explicit
'--------------------------------------------
Dim wkbname, ModDate, Direc, DirList, DirListB, AryFiles() As String
Dim IncFile, A, AA, B, BB, UB1, UB2 As Integer
Dim ChosenFile, SelParts(), SelPI()
Dim wkb As Workbook
'--------------------------------------------
Dim FiRow, PRPO, Tril, CstAbb, Dest, PNLis As String
Dim DDates(), PNList(), IsBlnk, rbit, rbitext As String
Dim RvLvl(), Qty(), PON(), CustN(), Cmpr(1 To 16) As String
Dim bi, rbi, rbir, di, fr, ri, fi, S, T, U, cl As Integer
Dim PNCnt, PNVal, CmpFlag, LpCnt, PNSel, PNCol, RvCol, QtCol, POCol, CNCol As Integer
Dim FileSearch


Dim FileArray(), FileArrayA(), FileArrayB() As Variant
Dim mddt, File_Name As String
Dim FoundFiles As Integer



Dim i As Double

Private Sub UserForm_Initialize()
TextBox1.Text = Cells(4, 5).Text
TextBox1.Clear
TextBox1.AddItem "X:\PROCUREMENTS\CHRYS open order"
TextBox1.AddItem "X:\PROCUREMENTS\Ford  open orders"
TextBox1.AddItem "X:\PROCUREMENTS\GM  open orders"
TextBox1.AddItem "X:\PROCUREMENTS\Honda Open Orders"
TextBox1.AddItem "X:\PROCUREMENTS\Nissan Open Orders"
TextBox1.AddItem "X:\PROCUREMENTS\Subaru open orders"
TextBox1.AddItem "X:\PROCUREMENTS\Toyota  Open orders"
TextBox1.Text = TextBox1.List(0)


End Sub

Private Sub CommandButton4_Click()
' #2 - Show Files In Directory Button Click
' Lists *.xl* files from the directory chosen
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False

wkbname = ActiveWorkbook.Name

ListBox2.Clear
ListBox4.Clear

Direc = TextBox1.Text
DirList = Dir(Direc & "\*.xl*")
If DirList = "" Then Exit Sub

'-----------------------------
Set FileSearch = Application.FileSearch

With FileSearch
    .LookIn = Direc
    .FileName = "*.xl*"

If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
ReDim FileArray(.FoundFiles.Count, 1)
ReDim FileArrayA(.FoundFiles.Count, 1)
ReDim FileArrayB(.FoundFiles.Count, 1)
ReDim DirListB(.FoundFiles.Count, 1)
For i = 1 To .FoundFiles.Count
    FileArray(i, 1) = .FoundFiles(i)
    FileArrayA(i, 1) = Dir(.FoundFiles(i), vbDirectory)
    FileArrayB(i, 1) = Format(FileDateTime(.FoundFiles(i)), "mm/dd/yyyy h:mm AM/PM ")
    DirListB(i, 1) = FileArrayA(i, 1) & "   -   " & FileArrayB(i, 1)
    ListBox4.AddItem FileArrayB(i, 1)
    ListBox2.AddItem FileArrayA(i, 1)
    
Next i
End If
End With
  
End Sub

 

[redgreenrider]

Bump

 

[redgreenrider]

Bump