Sub test()
Dim myVar(): myVar = getHeadingTOC(ActiveDocument)
myVar(9, 2).Follow '9 is not significant; randomly chosen for test
End Sub
Function getHeadingTOC(oDoc As Document) As Variant
Dim Match, Matches, varArray
Dim item As Long, subItem As Long
Dim rgx As Object: Set rgx = CreateObject("VBScript.RegExp")
Dim ptrn As String: ptrn = "([\d\.]*)\s(.*)"
Dim rng As Range: Set rng = oDoc.Range(0, 0): rng.MoveStart wdStory, 9
Dim toc As TableOfContents
' On Error GoTo housekeeping
With rgx
.Pattern = ptrn
.MultiLine = False
.Global = True
.IgnoreCase = True
End With
Set toc = oDoc.TablesOfContents.Add(Range:=rng, UseHeadingStyles:=True, UpperHeadingLevel:=1, LowerHeadingLevel:=7, IncludePageNumbers:=False, UseHyperlinks:=True)
With toc.Range
ReDim varArray(1 To .Paragraphs.Count, 0 To 2)
For item = 1 To .Paragraphs.Count
With .Paragraphs(item).Range
Set Matches = rgx.Execute(Trim$(.Text))
For Each Match In Matches
For subItem = 0 To Match.Submatches.Count - 1
varArray(item, subItem) = Match.Submatches(subItem)
Next subItem
Set varArray(item, 2) = .Hyperlinks(1)
Next Match
End With
Next item
End With
getHeadingTOC = varArray
housekeeping:
If Not toc Is Nothing Then toc.Delete
Set toc = Nothing
Set Match = Nothing
Set Matches = Nothing
Set rgx = Nothing
Set rng = Nothing
End Function
getHeadingTOC返回以下类型的二维变体数组: - myVar(X,0)是一个String - myVar(X,1)是一个String - myVar(X,2)是一个Word.Hyperlink对象
通过检查,数组将保留包含所需超链接的提供函数(getHeadingTOC),但数组在删除超链接时到达_test,因此在尝试执行Follow命令时失败(生成5825错误)。
我对这种意外行为缺少什么?