Sub listfile()
"""""""""""""""""""""""""""""""""""""""""""""
" 宏由录制，时间: -5-12 "
" 批量获取指定目录下所有文件名 "
""
""""""""""""""""""""""""""""""""""""""""""""
Dim fs
Dim mypath As String
Dim theSh As Object
Dim theFolder As Object
On Error Resume Next
"设置搜索路径
Set theSh = CreateObject("shell.application")
Set theFolder = theSh.BrowseForFolder(0, "", 0, "")
If Not theFolder Is Nothing Then
mypath = theFolder.Items.Item.Path
End If
"搜索开始
Set fs = Application.FileSearch
With fs
.NewSearch
.SearchSubFolders = True "搜索子目录
.LookIn = mypath "搜索路径
.Filename = "*.JPG" "搜索文件类型为JPG
If .Execute(SortBy:=msoSortByFileName) > 0 Then
c = .FoundFiles.Count"统计搜索到的文件个数
For i = 1 To c
strTemp = .FoundFiles(i) "设置临时文件
n = InStrRev(strTemp, "\") "获取文件路径长度（不包括文件名）
"获取文件名及扩展名
strfilename = Replace(strTemp, Left(strTemp, n), "")
" Cells(i, 1) = strTemp "输出格式为：文件路径+文件名+扩展名
" Cells(i, 1) = Mid(strTemp, n + 1) "输出格式为：文件名+扩展名
"从D8单元格开始输出格式为：文件名，请自行修改。
Cells(i + 7, 4) = Left(strfilename, Len(strfilename) - 4)
Next
Else
MsgBox "该文件夹里没有符合要求的文件!"
End If
End With
Set fs = Nothing
End Sub
如果觉得《批量获取指定目录下所有文件名》对你有帮助，请点赞、收藏，并留下你的观点哦！
