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