如何在大批文件中找到有链接的文件表格

125675117

我自己顶上去，别沉了

裂魂人

半百

125675117 发表于 2022-3-28 15:25
老师，目前只能识别当前所在文件夹内的excel文件的链接，能不能改成包含子目录下所有excel文件都可识别， ...

Sub 查询()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
P = ThisWorkbook.Path & "\"
d.Add P, ""
I = 0
Do While I < d.Count
  brr = d.keys
  F = Dir(brr(I), vbDirectory)
  Do While F <> ""
      If F <> "." And F <> ".." Then
          If (GetAttr(brr(I) & F) And vbDirectory) = vbDirectory Then d.Add (brr(I) & F & "\"), ""
      End If
      F = Dir
  Loop
  I = I + 1
Loop
For Each k In d.keys
    F = Dir(k & "*.XLSX")
    Do While F <> ""
        If F <> ThisWorkbook.Name Then
            Set WB = Workbooks.Open(P & F)
            For Each sh In WB.Sheets
                Set Rng = sh.Cells.Find("*\*")
                If Not Rng Is Nothing Then
                    s = Rng.Address
                    Do
                        n = n + 1
                        With ThisWorkbook.Sheets(2)
                            .Cells(n, 1) = k
                            .Cells(n, 2) = F
                            .Cells(n, 3) = sh.Name
                            .Cells(n, 4) = s
                        End With
                        Set Rng = sh.Cells.FindNext(Rng)
                    Loop While s <> Rng.Address
                End If
            Next
            WB.Close
        End If
        F = Dir
    Loop
Next
Set d = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

半百

发重了。。。。。。

125675117

半百 发表于 2022-3-29 12:28
Sub 查询()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

半百老师，请再看看，怎么会报错

半百

125675117 发表于 2022-3-29 14:11
半百老师，请再看看，怎么会报错

不好意思，Set WB = Workbooks.Open(p & F) 忘改了， Set WB = Workbooks.Open(k & F)

125675117

半百 发表于 2022-3-29 14:36
不好意思，Set WB = Workbooks.Open(p & F) 忘改了， Set WB = Workbooks.Open(k & F)

完美！！谢谢

125675117

半百 发表于 2022-3-29 14:36
不好意思，Set WB = Workbooks.Open(p & F) 忘改了， Set WB = Workbooks.Open(k & F)

半百老师，帮忙看看附件，有一个小错误待解决，谢谢。

半百

125675117 发表于 2023-1-6 09:00
半百老师，帮忙看看附件，有一个小错误待解决，谢谢。

试试

125675117

半百 发表于 2023-1-6 11:54
试试

可以了，完美解决，谢谢老师！！！新年快乐，身体健康！