代码实现重新构建所有链接,如果要单独刷新某
文件夹的文件链接,可仿效代码(可不用单独刷新,如有增删,重新全部构建)。
Sub test()
Dim fso, fp, ar, ar1, subf, f, n%, m%, i%, j%, c As Range
Sheets("6月").Activate
ActiveSheet.UsedRange.Offset(2) = ""
Set fso = CreateObject("scripting.filesystemobject")
Set fp = fso.getfolder(ThisWorkbook.Path).subfolders
ReDim ar(1 To fp.Count)
For Each subf In fp
n = n + 1
If subf.Files.Count <> 0 Then
ReDim ar1(1 To subf.Files.Count)
m = 0
For Each f In subf.Files
m = m + 1
ar1(m) = f & "|" & fso.getbasename(subf) & "|" & fso.getbasename(f)
Next
ar(n) = ar1
End If
Next
For i = 1 To UBound(ar)
If IsArray(ar(i)) Then
Set c = Rows(1).Find(Split(ar(i)(1), "|")(1))
If Not c Is Nothing Then
For j = 1 To UBound(ar(i))
With c.End(xlDown)
.Offset(1).Value = Split(ar(i)(j), "|")(2)
ActiveSheet.Hyperlinks.Add Anchor:=.Offset(1), Address:=Split(ar(i)(j), "|")(0)
End With
Next
End If
End If
Next
Set fso = Nothing
End Sub