VBA Search String Expression…

Topic

New Reply

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 (see attached Word file):

Code:

 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

Reply | Quote

Replies

Try this. Note that the initial search string was slightly modified to avoid the PDF series also finding the HTM series strings

Code:

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)
  ''sID = "BM1010"      'for testing purposes only
  Set r = ActiveDocument.Range
  SearchString = "BM[0-9]{4}.[A-Z0-9.]{4,}>"
  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
 
  Set r = ActiveDocument.Range
  ''sID = "BM10010"      'for testing purposes only
  SearchString = "BM[0-9]{5}[A-Z0-9.]{5,}>"
  With r.Find
    .MatchWildcards = True
    Do While .Execute(FindText:=SearchString, Forward:=True) = True
      sHL = Replace(Mid(r.Text, 8), ".", "") & ".htm"
      If Left(r.Text, 7)  sID Then
        sHL = "../" & Left(r.Text, 7) & "/" & 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

Reply | Quote

Thanks Andrew… the macro code works in one direction (for example: BM1010 to BM10010), but not the inverse.

There is a variation that can occur, when the active document is a BM10010.01.02.03 (for example) that needs to have it’s own document hyperlink as: 010203.htm – and all other document references have the 6 character document number: “../BMxxxx/010203.pdf”.

We also prefer to have a dialog box that asks the user which is the active BM document volume (such as: BM1010, or BM10010) as a reference point to insert the correct format for the hyperlinks.

Here’s the slightly revised macro, but this only works with 6 characters of the BM number (such as: BM1010), not the 7 character BM number (BM10010).

Sub DocHyperlinks()
‘ Macro to insert Document hyperlinks
Dim sID As String, r As Range
Dim SearchString As String, sHL As String

sID = InputBox(“What is the BM Volume Number for this document? Enter the first 6 or 7 characters of the file name: BMXXXX”, “BM Volume Number”, “BM”)
If Len(sID) 6 Then
MsgBox “Cancel was selected, No Hyperlinks are inserted in the file”, vbCritical + vbOKOnly, “Cancelled”
Else

Set r = ActiveDocument.Range
SearchString = “BM[0-9]{4}.[A-Z0-9.]{4,}>”
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

sID = Left(ActiveDocument.Name, 7)
Set r = ActiveDocument.Range
”sID = “BM10010” ‘for testing purposes only
SearchString = “BM[0-9]{5}[A-Z0-9.]{5,}>”
With r.Find
.MatchWildcards = True
Do While .Execute(FindText:=SearchString, Forward:=True) = True
sHL = Replace(Mid(r.Text, 8), “.”, “”) & “.htm”
If Left(r.Text, 7) sID Then
sHL = “../” & Left(r.Text, 7) & “/” & 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 If
End Sub

Reply | Quote

Cross-posted at: http://www.vbaexpress.com/forum/showthread/?56532-VBA-Search-String-Expression

timdata: Please read the Lounge’s cross-posting requirements in Rule #14: http://windowssecrets.com/forums/faq.php?faq=rules_vision#crossposting

VBA Express has similar requirements, with which you also should comply.

Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Reply | Quote

Sorry, I have just posted a comment on VBA express forum… to request users to redirect to this forum for this posting.

Reply | Quote

Change the line
If Len(sID) 6 Then

to
If Len(sID) 7 or Left(sID,2) “BM” Then

Reply | Quote