你的意思是这样创建大纲 http://msdn.microsoft.com/en-us/library/bb960898.aspx函数（实际上将源 Word 文档中的所有标题复制到新的 Word 文档中）：
（我相信astrHeadings = docSource.GetCrossReferenceItems http://msdn.microsoft.com/en-us/library/aa201500(office.10).aspx(wdRefTypeHeading)函数是这个程序的关键，应该允许您检索您所要求的内容）
Public Sub CreateOutline()
Dim docOutline As Word.Document
Dim docSource As Word.Document
Dim rng As Word.Range
Dim astrHeadings As Variant
Dim strText As String
Dim intLevel As Integer
Dim intItem As Integer
Set docSource = ActiveDocument
Set docOutline = Documents.Add
' Content returns only the main body of the document, not the headers/footer.
Set rng = docOutline.Content
' GetCrossReferenceItems(wdRefTypeHeading) returns an array with references to all headings in the document
astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)
For intItem = LBound(astrHeadings) To UBound(astrHeadings)
' Get the text and the level.
strText = Trim$(astrHeadings(intItem))
intLevel = GetLevel(CStr(astrHeadings(intItem)))
' Add the text to the document.
rng.InsertAfter strText & vbNewLine
' Set the style of the selected range and
' then collapse the range for the next entry.
rng.Style = "Heading " & intLevel
rng.Collapse wdCollapseEnd
Next intItem
End Sub
Private Function GetLevel(strItem As String) As Integer
' Return the heading level of a header from the
' array returned by Word.
' The number of leading spaces indicates the
' outline level (2 spaces per level: H1 has
' 0 spaces, H2 has 2 spaces, H3 has 4 spaces.
Dim strTemp As String
Dim strOriginal As String
Dim intDiff As Integer
' Get rid of all trailing spaces.
strOriginal = RTrim$(strItem)
' Trim leading spaces, and then compare with
' the original.
strTemp = LTrim$(strOriginal)
' Subtract to find the number of
' leading spaces in the original string.
intDiff = Len(strOriginal) - Len(strTemp)
GetLevel = (intDiff / 2) + 1
End Function
@kol 于 2018 年 3 月 6 日更新
虽然astrHeadings是一个数组（IsArray回报True, and TypeName回报String()）我得到一个type mismatch当我尝试在 VBScript 中访问其元素时出现错误（Windows 10 Pro 1709 16299.248 上的 v5.8.16384）。这肯定是 VBScript 特定的问题，因为如果我在 Word 的 VBA 编辑器中运行相同的代码，我就可以访问这些元素。我最终迭代了 TOC 的各行，因为它甚至可以在 VBScript 中工作：
For Each Paragraph In Doc.TablesOfContents(1).Range.Paragraphs
WScript.Echo Paragraph.Range.Text
Next
本文内容由网友自发贡献，版权归原作者所有，本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容，请联系:hwhale#tublm.com(使用前将#替换为@)
