Word Macro to Mass Hyperlink variable length strings - vba

Question

I've been looking through the forums for a while now trying to find an answer to my problem, and either I'm dense or it hasn't been answered, so here I am.
Long story short, my job involves writing up word documents that list building deficits and provides hyperlinks to images of said deficits. The visible hyperlink text always follows the same format: '[site abbreviation][(image number)].JPG'. For example, if we are looking at 'Administrative Building', our images will be named 'AB(1).JPG', 'AB(2).JPG', etc, often into the mid-hundreds or thousands. In the word document, they are referenced as 'AB1', 'AB2' etc.
Currently, I have a macro that allows me to automatically create a hyperlink once I've selected the text, but I am trying to create a macro that will look through a document (or better yet, a highlighted selection) and assign hyperlinks to any text that starts with the site's abbreviation all at once.
My current attempt at a mass-hyperlinking macro is frustratingly close, but has one major error: while it will correctly hyperlink the first image name it finds, all subsequent images are linked with the next two characters included in the link. For example, if a sentence were to say "This is not correct (AB33), but this is correct (AB34)', my macro will hyperlink the text 'AB34' (which is correct) and 'AB33) ' (which is incorrect).
This is the macro I've been working with thus far (note that the text between the lines of 'XXXX...' are basic instructions for my coworkers to change the link destination as needed)
Option Explicit
Sub Mass_Hyperlink_v_1_1()
'incomplete: selects incorrect text after first link
Dim fileName As String
Dim filePath As String
Dim rng As Range
Dim tag As String
Dim FileType As String
Dim folder As String
Dim space As String
Dim start As String
Dim report_type As String
Dim temp As String
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Do not touch anything above this line
'Answer the following for the current document. Leave all quotations.
report_type = "CL" 'CL = Checklist
'SR = Site Report
folder = "Doors" 'The name of the folder you are linking images from
'Must match folder exactly
tag = "FS" 'Put file prefix here (ex. if link says "AB123", put "AB")
space = "No" 'Does the image file have a space in it? (ex. if file name is "AB (23)", put "yes")
FileType = ".JPG" 'make sure filetype extensions match
'Do not touch anything below this line
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
If space = "Yes" Then
start = "%20("
Else: start = "("
End If
If report_type = "CL" Then
folder = "..\Images\" & folder
Else: folder = folder
End If
If report_type = "SR" Then
folder = "Images\" & folder
Else: folder = folder
End If
Set rng = ActiveDocument.Range
With rng.find
.MatchWildcards = True
Do While .Execute(findText:=tag, Forward:=False) = True
rng.MoveStartUntil (tag)
rng.Select
Selection.Extend
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
'I believe the issue is created here
Selection.start = Selection.start + Len(tag)
ActiveDocument.Range(Selection.start - Len(tag), Selection.start).Delete
fileName = Selection.Text
filePath = folder & "\" & tag & start & fileName & ")" & FileType
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, address:= _
filePath, SubAddress:="", ScreenTip:="", TextToDisplay:= _
tag & Selection.Text
rng.Collapse wdCollapseStart
Loop
End With
End Sub
If I've explained this terribly wrong or not provided enough information, please let me know and I'll try to be more clear. And if there is a helpful resource that I'm simply too dense to have found, please let me know! thank you!
edit: if anyone knows how to only select words that start with the tag as opposed to words with the tag text in them, I'd be incredibly appreciative as well!

Answer 1

If you want to match a fixed tag followed by a variable number of digits:
Sub Tester()
TagMatches ActiveDocument, "AB"
End Sub
Sub TagMatches(doc As Document, tag As String)
Dim rng
Set rng = doc.Range
With rng.Find
.Text = tag & "[0-9]{1,}"
.Forward = True
.MatchWildcards = True
Do While .Execute
Debug.Print rng.Text
Loop
End With
End Sub
See: http://word.mvps.org/faqs/general/usingwildcards.htm