VBA Search String Expression

[timdata]

I need some help with a macro that has a search string to insert hyperlinks. Here's the scenario:

BM1010 is the active document, and has a list of similar documents to reference:
BM1010.01.02.03 (macro correctly makes a hyperlink: 010203.pdf)
BM4010.01.02.D06 (macro correctly makes a hyperlink: ../BM4010/0102D06.pdf)
BM4010.01.02.C02 (macro correctly makes a hyperlink: ../BM4010/0102C06.pdf)
BM4010.01.02.H03 (macro correctly makes a hyperlink: ../BM4010/0102H06.pdf)

BM10010.01.01.05 - a hyperlink is needed for this (using 7 characters for this BM number, but in this case needs the extension “.htm” instead of ".pdf").
The end result macro hyperlink should be: ../BM10010/010105.htm

However, if the reference is in its own BM volume "BM10010" then the hyperlink should just be: 010105.htm

Below is the current macro:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub DocHyperlinks()
' Macro to insert Document hyperlinks
Dim sID As String, r As Range
Dim SearchString As String, sHL As String
sID = Left(ActiveDocument.Name, 6)
Set r = ActiveDocument.Range
SearchString = "BM[0-9]{4}[A-Z0-9\.]{5,}>"
With r.Find
.MatchWildcards = True
Do While .Execute(FindText:=SearchString, Forward:=True) = True
sHL = Replace(Mid(r.Text, 7), ".", "") & ".pdf"
If Left(r.Text, 6) <> sID Then
sHL = "../" & Left(r.Text, 6) & "/" & sHL
End If
ActiveDocument.Hyperlinks.Add Anchor:=r, Address:=sHL, _
SubAddress:="", ScreenTip:="Click to open document", TextToDisplay:=r.Text
With r
.Start = .Hyperlinks(1).Range.End
.End = ActiveDocument.Range.End
.Collapse
End With
Loop
End With
End Sub

[timdata]

Sorry, this posting is also on Windows Secrets form... please go to that website to add your comments.