将标题、来源、日期、浏览网站放进数组

附件

新建 Microsoft Office Word 文档.rar(11.35 KB)

2011-5-18 00:19, 下载次数: 2

复制内容到剪贴板

代码:

Sub test()
    Dim info() As String
    Dim i As Integer
    Dim a As String
    Dim Hplnk As Hyperlink
    Dim b() As String
   
    ReDim info(ActiveDocument.Hyperlinks.Count - 1, 3)
    With ActiveDocument.Content.Find
        .Format = True
        .Font.Bold = True
        Do While .Execute  '提取标题信息，假设标题均为加粗字体，且只有标题才是加粗字体
            a = .Parent.Text
            a = Replace(a, Chr(13), "")
            info(i, 0) = a
            i = i + 1
            .Parent.Collapse wdCollapseEnd
        Loop
        i = 0
        .Parent.WholeStory
        .Text = "来源：[!^13^32]@^32@日期：[0-9-]{1,}"
        .Format = False
        .MatchWildcards = True
        Do While .Execute  '提取来源及日期信息
            a = .Parent.Text
            info(i, 1) = Split(a, "：")(1)
            info(i, 1) = Split(info(i, 1), " ")(0)
            info(i, 2) = Split(a, "：")(2)
            i = i + 1
            .Parent.Collapse wdCollapseEnd
        Loop
        i = 0
        For Each Hplnk In ActiveDocument.Hyperlinks  '提取网址信息
            info(i, 3) = Hplnk.Address
            i = i + 1
        Next
    End With
    ReDim b(UBound(info, 1))
    For i = 0 To UBound(info, 1)
         b(i) = info(i, 0) & vbTab & info(i, 1) & vbTab & info(i, 2) & vbTab & info(i, 3)
    Next
    Documents.Add.Content.Text = Join(b, vbCrLf)
End Sub