vba 刷新产生目录后，点击表名，自动跳转相应表格

蓝天星空

请老师们帮忙。
工作中不同项目产生不同数量的工作表，即使同一项目，也会有工作表的增减，现在我实现了通过刷新自动产生相应目录（包括序号/表全称/工作表名），但由于工作表的数目是变动的，不能通过编辑编辑超链接实现跳转（刷新后，链接失效）。我希望通过vba方式，在刷新目录同时，产生跳转链接。现向各位专家求助。

lightsnow

Sub WriteFolderInfo()
'年代已久代码来源不详
Dim shApp As Object, path1 As Object, Path2 As String, LP As Boolean, AF As Boolean, Down As VbMsgBoxResult
Down = MsgBox("是否创建链接？", vbYesNo + vbDefaultButton2, "提示")
If Down = vbYes Then LP = True
AF = True
Set shApp = CreateObject("Shell.application")
Set path1 = shApp.BrowseForFolder(0, "请选择文件夹", 0, 17)
If path1 Is Nothing Then
    Exit Sub
End If
Path2 = IIf(IsError(path1.Items.Item.path), path1.Title, path1.Items.Item.path)
'ActiveWorkbook.Worksheets.Add
Workbooks.Add
ActiveSheet.Outline.SummaryRow = xlAbove
Application.ScreenUpdating = False
WriteInfo Path2, 1, 1, LP, AF
Application.ScreenUpdating = True
End Sub

蓝天星空

lightsnow 发表于 2020-7-20 11:09
Sub WriteFolderInfo()
'年代已久代码来源不详
Dim shApp As Object, path1 As Object, Path2 As String, ...

谢谢。
不过我的问题是在刷新建立目录的同时，在表名下建立跳转链接，而不是创建信息文件夹。下面是我创建目录的代码：

Sub 目录()
  Cells.ClearContents
  n = 0
  Cells(5, 2).Select
  ActiveCell.FormulaR1C1 = "序号"
  Cells(5, 3).Select
  ActiveCell.FormulaR1C1 = "目录"
  Cells(5, 4).Select
  ActiveCell.FormulaR1C1 = "表名"

  For x = 3 To Sheets.Count
    If Sheets(x).Name = "参数表" Then
    n = n + 1
    Else
    Cells(x + 3 - n, 2) = x - 2
    Cells(x + 3 - n, 3) = Sheets(x).Cells(5, 3)
    Cells(x + 3 - n, 4) = Sheets(x).Name
    End If
  Next x
End Sub

lightsnow

是我对“目录”的理解错了，你看一下这个代码
工作簿1.rar (18.63 KB, 下载次数: 18)

2020-7-21 09:26 上传

点击文件名下载附件

蓝天星空

谢谢！这正是我需要的。
不过，现在又遇到新的问题：我的工作表有一组内容一样，但附有不同编码的表组成。如A, A (1), A (2)..., 后续的表是由表A复制而成，分别记载不同时间的事件。现在自动产生目录链接后，母表的链接有效，但子表的链接却失败了。不知道何故？按道理应该同样有效才对。