CODEWITHSUNDEEP
vbareplacems-wordhyperlink
kckay
kckay

Reputation: 1

A Macro to search a Word document for a string and change it to a hyperlink

I have a Word macro that will search the Word document for a string and will then change it to a hyperlink. The issue I am having is I need to search the document for multiple strings and replace each with their own hyperlink. My macro will find the first string and put every hyperlink after the other. I figure it should be a simple fix to correct. As an example, I included only 2 of the 19 strings I need to change to hyperlinks. They will work individually, but not when all in a macro. This is a Word macro.

Sub Add_Hyperlinks()
'
' Add_Hyperlinks Macro
'
'
' Certified Water Professionals

    Dim linkText As String
    Dim link As String
    Dim foundsomething As Range
    
    linkText = "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
    link = "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=link, SubAddress:="", ScreenTip:="", TextToDisplay:=linkText
    
' Compliance
    linkText = "https://wqcdcompliance.com"
    link = "https://wqcdcompliance.com"
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "https://wqcdcompliance.com"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=link, SubAddress:="", ScreenTip:="", TextToDisplay:=linkText
    
End Sub

Upvotes: 0

Views: 420

Answers (2)

Tim Williams
Tim Williams

Reputation: 166126

This may not be optimal, since I'm totally not a Word VBA person, but it worked for me.

Sub Add_Hyperlinks()

    Dim doc As Document
    
    Set doc = ActiveDocument
    
    Linkify doc, "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals", _
                 "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
    
    Linkify doc, "https://wqcdcompliance.com", _
                 "https://wqcdcompliance.com"
                 
    'etc for other links....
    
End Sub

'Find all instances of text `findWhat` in document `doc`, and
'  apply a hyperlink using URL `linkURL`
'Add a fourth parameter if you also need to control the link text. 
Sub Linkify(doc As Document, findWhat As String, linkURL As String)
    Dim rng As Range, col As New Collection, i As Long
    Set rng = doc.Range
    ResetFind rng.Find
    Do While rng.Find.Execute(findtext:=findWhat)
       ' `rng` is now the found text
       col.Add rng.Duplicate 'collect all found ranges
    Loop
    Debug.Print col.Count & " instances of '" & findWhat & "'"
    For i = col.Count To 1 Step -1 'link all found ranges
        doc.Hyperlinks.Add Anchor:=col(i), Address:=linkURL, _
          SubAddress:="", ScreenTip:="", TextToDisplay:=col(i).Text
    Next i
End Sub

Sub ResetFind(f As Find)
    With f
        .ClearFormatting
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
End Sub

Upvotes: 1

taller
taller

Reputation: 18762

Please update arrLinkText and arrLink accordingly to incorporate all 19 strings (hyperlink).

  • If linkText and link are always same, using one array is enough
  • If linkText comes from Excel, it is easy to collect them from Excel with VBA code
Option Explicit
Sub AddHyperlinksToURLs()
    Dim rng As Range, i As Integer
    Dim arrLinkText, arrLink
    ' Update as need
    arrLinkText = Array("http://www.xxx.gov/cdphe/ccwp-certified-water-professionals", _
        "https://wqcdcompliance.com")
    arrLink = Array("http://www.xxx.gov/cdphe/ccwp-certified-water-professionals", _
        "https://wqcdcompliance.com")
    If UBound(arrLink) <> UBound(arrLinkText) Then
        MsgBox "Strings don't match with Hyperlinks."
        Exit Sub
    End If
    Set rng = ActiveDocument.Content
    For i = 0 To UBound(arrLink)
        With rng.Find
            .ClearFormatting
            .Text = arrLinkText(i)
            Do While .Execute
                If .Found Then
                    rng.Hyperlinks.Add Anchor:=rng, Address:=arrLink(i)
                    rng.Collapse wdCollapseEnd
                End If
            Loop
        End With
    Next i
End Sub

Upvotes: 1

Related Questions