Sub ListFilesInCurrentFolder()
'List all the filenames in the current folder in a new worksheet
Dim f()
Dim strTemp As String
Dim intCount As Integer
Dim ws As Worksheet
intCount = 0
strTemp = Dir("*.*")
Do While strTemp <> Empty
intCount = intCount + 1
ReDim Preserve f(1 To intCount)
f(intCount) = strTemp
strTemp = Dir
Loop
Set ws = Workbooks.Add.Worksheets(1)
ws.Cells(1, 1).Resize(UBound(f), 1).Value = _
WorksheetFunction.Transpose(f)
End Sub