求助，此问题如何解决

Nhand

我想通过一段代码实现文件夹及子文件夹下所有xls文档的遍历，以搜索出包含特定内容的所有xls文档的路径。这段代码在小范围内测试是准确的，比如我一个文件夹下面放2个子文件夹，然后7,8层子文件夹下再放xls文档，能得出正确结果，但是如果我随意搜索一个包含大量文件的文件夹，都会得到一个统一的结果：自动打开了一个xlsm文档，名称为示例144 检查电脑名称。xlsm（只读）下面提示 对不起，您不是合法用户，文件将关闭！ 请问这是怎么回事？
Sub sousuo()
path = ThisWorkbook.FullName
aa = 0
inp1 = Application.InputBox("功能选择  1 :只要查找到数据就退出程序  2：查找出所有出现数据的文档（耗时长) ")
inp = Application.InputBox("请输入要查找的内容,点击确定后选择一个要搜索的文件夹")
'''''''查找所有xls文档
Set ob = CreateObject("Shell.Application")
    Set obf = ob.BrowseForFolder(0, "选择文件夹", 0, 0)
    If Not obf Is Nothing Then lj = obf.self.path & "\"
    Set obf = Nothing
    Set ob = Nothing
    Set d = CreateObject("Scripting.dictionary")    '创建一个字典对象
    Set dd = CreateObject("Scripting.dictionary")   '存放所有xls文档路径
    d.Add (lj), ""
    i = 0
    Do While i < d.Count
        keyy = d.keys   '开始遍历字典
        nm = Dir(keyy(i), vbDirectory)    '查找目录
        Do While nm <> ""
            If nm <> "." And nm <> ".." Then
                If (GetAttr(keyy(i) & nm) And vbDirectory) = vbDirectory Then    '如果是次级目录
                    d.Add (keyy(i) & nm & "\"), ""  '就往字典中添加这个次级目录名作为一个条目
                End If
            End If
            nm = Dir    '继续遍历寻找
        Loop
        i = i + 1
    Loop
   
    For Each keyy In d.keys
        nm = Dir(keyy & "*.xls")
        Do While nm <> ""
            dd.Add (Keyy & nm), ""
            nm = Dir
        Loop
    Next
''''''''''''''''''查找所有xls文档结束
Set d1 = CreateObject("scripting.dictionary")
For Each t In dd.keys
   If t <> path Then
    Workbooks.Open t, 0
    For Each y In ActiveWorkbook.Worksheets
    Set r = y.UsedRange.Find(inp)
      If Not r Is Nothing Then
            
            d1(t) = ""
            aa = aa + 1
            If inp1 = 1 Then
               ActiveWorkbook.Close False
               GoTo 1
            End If
            
      End If
    Next
    ActiveWorkbook.Close False
    End If
Next
1  If aa = 0 Then
      MsgBox "没有查找到相关内容"
      Else
      Workbooks.Add
      ActiveWorkbook.ActiveSheet.Cells(1, 1) = "以下是查找到数据的文件路径"
      a = 2
      For Each m In d1.keys
      ActiveWorkbook.ActiveSheet.Cells(a, 1) = m
      a = a + 1
      Next
      End If
End Sub

excel玉米

应该是wps和excel不完全兼容吧。

Nhand

找到原因了，代码错了，但是哪里错了不知道，因为我推翻重新写的。。。