Sub FileNames() Dim FName As String Dim FNames() As String Dim FType As String Dim i As Integer
FType = "*.xls"
FName = Dir(FType)
Do Until FName = ""
i = i + 1
ReDim Preserve FNames(1 To i)
FNames(i) = FName
FName = Dir
Loop If i <> 0 Then
For i = 1 To UBound(FNames)
MsgBox FNames(i)
Next i End If End Sub