EXCEL2010 FileSearch的问题，求高手指点

Question

就是读取文件夹里的EXCEL文件内容，赋值到运行VBA的的EXCEL文件里。
下面是代码，本人不是太懂代码，上网查了一下，EXCEL2010不让用Application.FileSearch，
那么怎么才能把Application.FileSearch代替掉啊。求高手指点，越详细越好，本人是菜鸟。
谢谢了！！！Private Sub CommandButton1_Click()
    Dim fileName       As String
    Dim kenSaKuFlg     As String
    Dim strKey         As String
    Dim oFileSearch    As Object
    Dim w_strTemp      As String
    Dim book           As String
    Dim rowNum         As Integer
    Dim sFileAllName   As String
    Dim sName()        As String
    Dim maxRowNum      As Integer
    Dim sFilePath      As String
    Dim sNum           As String
    Dim bug           As String
    Dim NewXlApp       As Excel.Application
    Dim num As Integer    sFilePath = Trim(TextBox1.Text)    Set oFileSearch = Application.FileSearch
    
    If sFilePath = "" Then
      MsgBox "検索フォルダを入力してください。"
      Exit Sub
    End If
    
    With oFileSearch
        .NewSearch
        .FileType = msoFileTypeAllFiles                '全て類型のファイル。
        .LookIn = sFilePath                            'ファイルタを指定する。
        .fileName = "*.xls"                            'ファイルを指定する。
        .SearchSubFolders = False
        .Execute
        'ファイルを存在する。
        For i = 1 To .FoundFiles.Count
            num = 0
            Set NewXlApp = New Excel.Application
            sFileAllName = .FoundFiles(i)
            sName = Split(.FoundFiles(i), "\")
            sFileName = sName(UBound(sName))
            NewXlApp.Workbooks.Open sFileAllName
            
            sNum = NewXlApp.Sheets(1).Range("K6").Value
            bug = NewXlApp.Sheets(1).Range("O18").Value
            a1 = NewXlApp.Sheets(1).Range("O19").Value
            a2 = NewXlApp.Sheets(1).Range("N27").Value
            
            NewXlApp.Quit
            Set NewXlApp = Nothing
            
            Cells(i + 1, 8) = sFileName
            Cells(i + 1, 9) = sNum
            Cells(i + 1, 10) = bug
            Cells(i + 1, 11) = a1
            Cells(i + 1, 12) = a2        Next
         
    End With    MsgBox "処理が終了します、確認してください。"End Sub

Answer 1

看来偶out啦.........
我的电脑还是2003+2007

Answer 2

Office 2007 也不支持这个。 不过，看到你用到了 .SearchSubFolders = False ，那就很好办了。
不用搜索子目录，很好处理。可以写一个很简单的函数，来替代它。
Private Function SearchFiles(sPath As String, sFileName As String) As String()
    Dim aList() As String
    Dim sTemp   As String
    Dim i&, k&, U As Long    If (Right$(sPath, 1) = "\") Then
        sTemp = sPath & sFileName
    Else
        sTemp = sPath & "\" & sFileName
    End If
    k = -1:    U = 31
    ReDim aList(U)
    sTemp = Dir$(sTemp, 7&)
    Do
        If (Len(sTemp) = 0) Then Exit Do
        k = k + 1
        If (k > U) Then
            U = U + 8
            ReDim Preserve aList(U)
        End If
        aList(k) = sTemp
        sTemp = Dir$()
    Loop
    If (k >= 0) Then ReDim Preserve aList(k)
    SearchFiles = aList
End Function' 应用示例：
Private Sub test()
    Dim aFiles() As String
    Dim i&
    ' 搜索 “D:\文档” 中的所有 .xls 文件：
    aFiles = SearchFiles("D:\文档", "*.xls")
    For i = 0 To UBound(aFiles)
        Debug.Print i, aFiles(i)
    Next
End Sub

Answer 3

如果你可以搜到filesearch弃用，那应该可以看到可以用application.findfile方法替代。其实两个功能是一样的，都是打开指定的文件，并返回给一个application变量。