Variant数组中的对象在访问时会消失

时间:2018-04-09 22:04:08

标签: arrays vba object ms-word variant

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错误)。

我对这种意外行为缺少什么?

0 个答案:

没有答案