EXCEL _VBA(檔案列表)

Sub 檔案列表()


Dim myPath As String

Dim myFileName As String

Dim i As Long

myPath = ThisWorkbook.Path & "\"
myFileName = Dir(myPath, 0)

i = 1

Do While Len(myFileName) > 0



Cells(i, 1) = myFileName

myFileName = Dir()

i = i + 1

Loop

k = 1

For j = 1 To i

If Right(Cells(j, 1), 3) = "xls" Then

Cells(k, 2) = Cells(j, 1)



k = k + 1



End If

Next

Columns(1).Delete



End Sub


Sub 指定檔案()

Dim myFs As FileSearch

Dim myPath As String

Dim myClc As New Collection

Dim i As Long

Set myFs = Application.FileSearch

myPath = ThisWorkbook.Path
With myFs

.NewSearch

.LookIn = myPath

.FileType = msoFileTypeAllFiles

.Filename = "*.xls"

.SearchSubFolders = True

If .Execute(SortBy:=msoSortByFileName) > 0 Then

For i = 1 To .FoundFiles.Count

If .FoundFiles(i) Like myPath & "*" Then

On Error Resume Next

myClc.Add .FoundFiles(i), .FoundFiles(i)

On Error GoTo 0

End If

Next

End If

End With

Set myFs = Nothing
With myClc

If .Count > 0 Then

For i = 1 To .Count


Cells(i, 1) = Right(.Item(i), Len(.Item(i)) - Len(myPath) - 1)

Next

Else


End If

End With

Set myClc = Nothing
End Sub