wwbwb
Well-known Member
- Joined
- Oct 20, 2003
- Messages
- 513
Good morning all
the following code lists all files in the directory listed in A1. It works just fine. What I would like to do now is be able to name the automatically name the sheet with the current folder. ie. The sheet name would be Test if the path listed in A1 were c:\temp1\temp2\Test\
I've tried a couple of different solutions, but am shot down each time. Ideas?
the following code lists all files in the directory listed in A1. It works just fine. What I would like to do now is be able to name the automatically name the sheet with the current folder. ie. The sheet name would be Test if the path listed in A1 were c:\temp1\temp2\Test\
I've tried a couple of different solutions, but am shot down each time. Ideas?
Code:
Sub ListFiles()
Application.ScreenUpdating = False
Range("a5:b65536").ClearContents
Range("a5").Select
Dim fileList() As String
Dim fName As String
Dim fPath As String
Dim I As Integer
Dim myfind As Integer, mylen As Integer, mynum As Integer
fPath = Range("A1")
fName = Dir(fPath & "*.*")
While fName <> ""
I = I + 1
ReDim Preserve fileList(1 To I)
fileList(I) = fName
fName = Dir()
Wend
If I = 0 Then
MsgBox "No files found"
Exit Sub
End If
For I = 1 To UBound(fileList)
myfind = WorksheetFunction.Find(".", fileList(I), 1) - 1
mylen = Len(fileList(I))
mynum = mylen - myfind
If Range("b1") = "x" Then
Range("A" & I + 4).Value = "=hyperlink(""" & fPath & fileList(I) & """)"
Range("A1").Select
Else
Range("A" & I + 4).Value = Left(fileList(I), myfind)
Range("B" & I + 4).Value = Right(fileList(I), mynum)
Range("A:A").Select
Selection.Font.ColorIndex = 1
Selection.Font.Underline = xlUnderlineStyleNone
Range("A1").Select
End If
Next
ActiveSheet.Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub