redgreenrider
New Member
- Joined
- Nov 6, 2013
- Messages
- 16
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.
Code:
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