ms-word - 使用 Open XML 将 Word 文档中的文本替换为 URL

Question

我在一个项目中遇到问题，我想用可点击的 URL 替换 Word 文档中的 som 标记文本。下面的示例代码使用仅包含文本 [Webpage] 的 word 文档。

这是有问题的代码：

 Imports DocumentFormat.OpenXml
 Imports DocumentFormat.OpenXml.Packaging
    
 Public Class Form1
     Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    
         MsgBox(processDocument("C:\temp\testdoc.docx", "[Webpage]", "Google", "https://www.google.com"), MsgBoxStyle.ApplicationModal + vbOKOnly, "Text replace test")
    
     End Sub
    
     Private Function processDocument(ByVal tDocFilename As String, ByVal tagText As String, ByVal replText As String, ByVal replURL As String) As String
    
    
         Using doc As WordprocessingDocument = WordprocessingDocument.Open(tDocFilename, True)
             Dim mainPart As DocumentFormat.OpenXml.Packaging.MainDocumentPart = doc.MainDocumentPart
    
             Dim textPLaceList As IEnumerable(Of Wordprocessing.Text) = mainPart.Document.Descendants(Of Wordprocessing.Text)()
    
             Try
                 For Each textPlaceHolder As Wordprocessing.Text In textPLaceList
                     Dim parent = textPlaceHolder.Parent
                     If (TypeOf parent Is Wordprocessing.Run) Then
                         If textPlaceHolder.Text.Contains("[") And textPlaceHolder.Text.Contains("]") Then
                             Dim tmpHyperlink As New DocumentFormat.OpenXml.Wordprocessing.Hyperlink
                             tmpHyperlink.Anchor = replText
                             tmpHyperlink.DocLocation = replURL
                             tmpHyperlink.InsertBefore(Of Wordprocessing.Hyperlink)(tmpHyperlink, textPlaceHolder.Parent)
                             textPlaceHolder.Remove()
                             Exit For
                         End If
                     End If
                 Next
                 processDocument = "OK"
             Catch ex As Exception
                 processDocument = "Could not replace text in document (" & ex.Message & ")"
             End Try
    
         End Using
    
     End Function
    
 End Class

当我尝试使用 InsertBefore 或 InsertAfter 时，我收到一条错误消息，告诉我对象的“状态”不正确。这意味着什么？

问候彼得卡尔斯特伦

标签： ms-wordhyperlinkopenxml

Answer 1

这个论坛没有太大帮助。

经过一番挖掘，我自己找到了解决方案。

以下是它的制作方法：

Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Wordprocessing
Imports DocumentFormat.OpenXml.Packaging

Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        MsgBox(processDocument("C:\temp\testdoc.docx", "[Webpage]", "Google", "https://www.google.com"), MsgBoxStyle.ApplicationModal + vbOKOnly, "Text replace test")

    End Sub

    Private Function processDocument(ByVal tDocFilename As String, ByVal tagText As String, ByVal replText As String, ByVal replURL As String) As String

        Using doc As WordprocessingDocument = WordprocessingDocument.Open(tDocFilename, True)
            Dim mainPart As DocumentFormat.OpenXml.Packaging.MainDocumentPart = doc.MainDocumentPart

            Dim textPLaceList As IEnumerable(Of Wordprocessing.Text) = mainPart.Document.Descendants(Of Wordprocessing.Text)()

            Try
                For Each textPlaceHolder As Wordprocessing.Text In textPLaceList
                    Dim parent As Wordprocessing.Paragraph = textPlaceHolder.Parent.Parent
                    If (TypeOf parent Is Wordprocessing.Paragraph) Then
                        If textPlaceHolder.Text.Contains("[") And textPlaceHolder.Text.Contains("]") Then
                            Dim newParagraph As Paragraph = getURLParagraph(mainPart, replText, replURL)
                            parent.Parent.InsertBefore(Of Wordprocessing.Paragraph)(newParagraph, parent)
                            textPlaceHolder.Remove()
                            Exit For
                        End If
                    End If
                Next
                processDocument = "OK"
            Catch ex As Exception
                processDocument = "Could not replace text in document (" & ex.Message & ")"
            End Try

        End Using

    End Function

    Private Function getURLParagraph(ByVal mainPart As MainDocumentPart, ByVal urlLabel As String, ByVal urlText As String) As Paragraph

        Dim urlExists As Boolean
        Dim hRelation As HyperlinkRelationship = Nothing

        Dim uri As System.Uri = New Uri(urlText)

        For Each hRel As HyperlinkRelationship In mainPart.HyperlinkRelationships
            If (hRel.Uri = uri) Then
                urlExists = True
                hRelation = hRel
                Exit For
            End If
        Next

        Dim relationshipId As String
        If Not urlExists Then
            Dim rel As HyperlinkRelationship = mainPart.AddHyperlinkRelationship(uri, True)
            relationshipId = rel.Id
        Else
            relationshipId = hRelation.Id
        End If

        Dim newParagraph As Paragraph = New Paragraph(New Hyperlink(New ProofError() With {
        .Type = ProofingErrorValues.GrammarStart
    }, New Run(New RunProperties(New RunStyle() With {
        .Val = “Hyperlnk”}), New Text(urlLabel))) With {
        .History = OnOffValue.FromBoolean(True),
        .Id = relationshipId
    })
        Return newParagraph

    End Function
End Class

问候彼得卡尔斯特伦