Microsoft Office Forums - View Single Post - Word macro to cut a range of text and apply to subsequent text as a hyperlink

Guessed · 07-20-2020, 03:59 PM

This code is not super reusable because of the hard coding of the path to be removed. It is probably possible to make this adapt dynamically by looking at the folder path where the Word document is saved and finding the overlap with the file path to the hyperlinks but that will take a fair bit of extra coding.

This is how you could make it back into a single macro with a hard coded path

Code:

Sub MakeMyLink()
  Dim aRng As Range, sFound() As String, sLink As String, sText As String
  
  'configure path to remove the path overlaps and make hyperlinks 'relative' to the location of the Word doc
  Const sCommon As String = "C:\Users\iaman\Desktop\eCTD_Office_Software\IND_Source_Folders\YFV_IND"
  
  Set aRng = ActiveDocument.Range
  With aRng.Find
    .Text = "\<\<(*)\>\>\<\<(*)\>\>"
    .MatchWildcards = True
    .Replacement.Text = "\1|\2"
    Do While .Execute
      sFound = Split(aRng.Text, ">><<")
      sText = Replace(sFound(1), ">>", "")
      sLink = Replace(sFound(0), "<<", "")
      sLink = Replace(sLink, sCommon, "..")
      sLink = Replace(sLink, "", "/")
      ActiveDocument.Hyperlinks.Add Anchor:=aRng, Address:=sLink, TextToDisplay:=sText
      aRng.Collapse Direction:=wdCollapseEnd
    Loop
  End With
End Sub