批量获取指定目录下所有文件名

Sub listfile()
'''''''''''''''''''''''''''''''''''''''''''''
' 宏由 www. 录制，时间: 2009-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