vbscript: replace text in activedocument with hyperlink

Question

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

score 0 · Answer 1 · answered Feb 15 '13 at 14:47

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.

THX - It didn't work out of the box, but I searched a bit further, and I have updated my first post. Could you take a look at it? — zenlord, Feb 15 '13 at 17:08
VBScript cannot handle named parameters like `Anchor:=foo`. Try using the native version where the arguments are on fixed locations: `ActiveDocument.Hyperlinks.Add Anchor, Address, SubAddress, ScreenTip, TextToDisplay`. — AutomatedChaos, Feb 15 '13 at 18:56
FYI: `If Matches.Count >= 1 Then` is not needed, because if there are no matches, the execution will just fall through `For Each match In Matches` without processing the inner statements. — AutomatedChaos, Feb 15 '13 at 18:58

zenlord · Accepted Answer · 2013-02-18T15:24:06.703

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

In fact, I had to work out a little bug in the part where the regex is selected as a range. I'll update my answer to make it a complete piece of working code. — zenlord, Feb 18 '13 at 15:21

vbscript: replace text in activedocument with hyperlink

2 Answers2

Linked