[removed] replace text in activedocument with hype

问题:

Starting out at a new job and I have to go through a whole lot of documents that my predecessor left. They are MS Word-files that contain information on several hundreds of patents. Instead of copy/pasting every single patent-number in an online form, I would like to replace all patent-numbers with a clickable hyperlink. I guess this should be done with vbscript (I'm not used to working with MS Office).

I have so far:

<obsolete>

This is not working for me: 1. I (probably) need to add something to loop through the ActiveDocument 2. The replace-function probably needs a string and not an object for a parameter - is there a __toString() in vbscript?

THX!

UPDATE: I have this partially working (regex and finding matches) - now if only I could get the anchor for the hyperlink.add-method right...

Sub HyperlinkPatentNumbers()
'
' HyperlinkPatentNumbers Macro
'

Dim objRegExp, Matches, match, myRange

Set myRange = ActiveDocument.Content

Set objRegExp = CreateObject("VBScript.RegExp")
With objRegExp
    .Global = True
    .IgnoreCase = False
    .Pattern = "(WO|EP|US)([0-9]*)(A1|A2|B1|B2)"
End With

Set Matches = objRegExp.Execute(myRange)

If Matches.Count >= 1 Then
    For Each match In Matches
        ActiveDocument.Hyperlinks.Add Anchor:=objRegExp.match, Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"
    Next
End If

Set Matches = Nothing
Set objRegExp = Nothing

End Sub

回答1:

Is this VBA or VBScript? In VBScript you cannot declare types like Dim newText As hyperLink, but every variable is a variant, so: Dim newText and nothing more.

objRegEx.Replace returns the string with replacements and needs two parameters passed into it: The original string and the text you want to replace the pattern with:

Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Global = True
objRegEx.IgnoreCase = False
objRegEx.Pattern = "^(WO|EP|US)([0-9]*)(A1|A2|B1|B2)$"

' assuming plainText contains the text you want to create the hyperlink for
strName = objRegEx.Replace(plainText, "$1$2$3")
strAddress = objRegex.Replace(plainText, "http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=$1&NR=$2&KC=$3"

Now you can use strName and strAddress to create the hyperlink with.
Pro-tip: You can use objRegEx.Test(plainText) to see if the regexp matches anything for early handling of errors.

回答2:

Problem solved:

Sub addHyperlinkToNumbers()

Dim objRegExp As Object
Dim matchRange As Range
Dim Matches
Dim match

Set objRegExp = CreateObject("VBScript.RegExp")

With objRegExp
    .Global = True
    .IgnoreCase = False
    .Pattern = "(WO|EP|US|FR|DE|GB|NL)([0-9]+)(A1|A2|A3|A4|B1|B2|B3|B4)"
End With

Set Matches = objRegExp.Execute(ActiveDocument.Content)

For Each match In Matches
    'This doesn't work, because of the WYSIWYG-model of MS Word:
    'Set matchRange = ActiveDocument.Range(match.FirstIndex, match.FirstIndex + Len(match.Value))

    Set matchRange = ActiveDocument.Content
    With matchRange.Find
        .Text = match.Value
        .MatchWholeWord = True
        .MatchCase = True
        .Wrap = wdFindStop
        .Execute
    End With

    ActiveDocument.Hyperlinks.Add Anchor:=matchRange, _
        Address:="http://worldwide.espacenet.com/publicationDetails/biblio?DB=EPODOC&adjacent=true&locale=en_EP&CC=" _
        & match.Submatches(0) & "&NR=" & match.Submatches(1) & "&KC=" & match.Submatches(2)

Next

MsgBox "Hyperlink added to " & Matches.Count & " patent numbers"

Set objRegExp = Nothing
Set matchRange = Nothing
Set Matches = Nothing
Set match = Nothing

End Sub