Converting All Plain Text Links to Hyperlinks

[kckay]

I have an Excel workbook that we input data into. once complete I run a macro that performs a mailmerge and some formatting of the text including changing plain text link addresses to blue/underline. This process worked great as we were a hard-copy shop. Due to the coronavirus, we are converting to electronic letter. I need to convert the plain text link to an active and correct link. I was unable to get any code to work in an Excel macro against the Word document, so now call this macro (thank you Techkie007) in the Word template (.dotm):

Sub Hyperlinker()
Dim Rng As Range

Set Rng = ActiveDocument.Range
With Rng.Find
    Do While .Execute(findText:="www.", Forward:=False) = True
    Rng.MoveEndUntil (" ")
        ActiveDocument.Hyperlinks.Add _
            Anchor:=Rng, _
            Address:=Rng.Text, _
            SubAddress:="", _
            ScreenTip:="", _
            TextToDisplay:=""
        Rng.Collapse wdCollapseStart
    Loop
End With

End Sub

This code does convert the plain text link to a hyperlink, but does so in the wrong information. It will place the full path directory of the Word document and append the link address into the hyperlink. For example: incorrect link is C:\this letter directory\wqcdcompliance.com where the correct link should be \wqcdcompliance.com.

How can I modify the code to only use the correct link?

Thank you for your assistance.

I did try:

Sub Hyperlinker()
    Word.Options.AutoFormatReplaceHyperlinks = True
   Selection.Range.AutoFormat
End Sub

It reformatted a couple of headings and a couple of sentences in the body, but the hyperlinks were correct.

 

[rlv01]

If "C:\this letter directory\wqcdcompliance.com" is what you are getting, but "\wqcdcompliance.com" is what you want, then perhaps.

            Anchor:=Rng, _
            Address:= "\" & Split(Rng.Text, "\")(UBound(Split(Rng.Text, "\"))), _
            SubAddress:="", _

Not tested.

 

[kckay]

Thank you. That is sooooo close! now the result is "file:///x:\wqcdcompliance"

Also, we are using Office 2016.

 

[rlv01]

The code I posted would never produce a result "file:///x:\wqcdcompliance". You are doing something in your code that you are not explaining.

 

[kckay]

The process used: an Excel workbook with multiple sheets are used to document an inspection. The sheets are summarized for violations and observations. A button is pressed on a custom ribbon that performs a mail-merge to a Word template with boilerplate language. The violations and observations are copied from an Excel sheet to the Word document. Near the end of the steps, I search for plain text links and change their color to blue and underline them. The problem I am having is converting the plain text link to an hyperlink. Attached is the code to do the search and replace for one of the plain text links; there are approximately 20 of these 'with' statements specific to plain text link.

The original Excel template is stored in Google G-Suite File Stream shared folder and referenced by "X:\Shared Drives\common folder name". The Word document is stored the same folder. When the process to create the inspection worksheet occurs, the Excel template is populated with data from a database data retrieval and stored on the user's Google G-Suite File Stream "X:\My Drive\user folder name". This Excel workbook is used to document the inspection. The letter is generated from this documentation from a Word template and stored in the user's "X:\My Drive\user folder name." The 'user folder name' is the name of the facility that the user is inspecting and is generated when the original Excel workbook is created.

Attached is a screen shot of a portion of the letter with the mouse hovering over the hyperlink.

Here is the code executed in Excel:

.
.
<mail-merge and other code to copy cells from Excel to Word template>
.
.
' Compliance
    With appWD.ActiveDocument.Content.Find
        .ClearFormatting
        .Font.Bold = False
        With .Replacement
            .ClearFormatting
            .Font.Underline = wdUnderlineSingle
            .Font.Color = RGB(0, 0, 255)
        End With
        .Execute FindText:="//wqcdcompliance.com", ReplaceWith:="//wqcdcompliance.com", _
            Format:=True, Replace:=wdReplaceAll
    End With

    appWD.Application.Run "Module1.Hyperlinker"
.
.
<housekeeping code to close documents, change worksheet, etc.>

Here is the code executed in Word:

Sub Hyperlinker()
    Dim Rng As Range
    
    Set Rng = ActiveDocument.Range
    
    With Rng.Find
        Do While .Execute(findText:="wqcdcompliance", Forward:=False) = True
        Rng.MoveEndUntil (" ")
            If Len(Rng.Text) > 1 Then
                ActiveDocument.Hyperlinks.Add _
                    Anchor:=Rng, _
                    Address:="\" & Split(Rng.Text, "\")(UBound(Split(Rng.Text, "\"))), _
                    SubAddress:="", _
                    ScreenTip:="", _
                    TextToDisplay:=""
                Rng.Collapse wdCollapseStart
            End If
        Loop
    End With
End Sub

 

[kckay]

If there is a place to upload the entire coding package, plus raw data to step through the entire process, I am good with doing that. The VBA is very rough as I learned it as I went, it is not my primary job - did after hours when not doing inspections, so please forgive the hack-job.

 

[rlv01]

In your original post, you gave us to understand that the delimiter character for the link addresses would be the backslash "\" character. My response to you was based on that information. Your new post implies that the Find result may vary a lot more than you first described. Though I'm unclear on the parameters, this might work.

    Anchor:=Rng, _
    Address:= "\" & Split(Replace(InputStr, "/", "\"), "\")(UBound(Split(Replace(InputStr, "/", "\"), "\"))), _
    SubAddress:="", _

 

[kckay]

My apologies on the clarity of my question - buried so deep in I was unable to see the trees.

I updated the Word macro and received a Runtime error '9' Subscript out of range on that line.

I really do appreciate the assistance.

 

[kckay]

The links in the letter could be deeper than my initial example: wqcdcompliance.com/forms or //www.colorado.gov/cdphe/ccwp-colorado-certified-water-professionals or etc.

 

[rlv01]

Sorry. "InputStr" was a variable I was using to test. It needs to be Rng.Text, ala:

Sub Hyperlinker()
    Dim Rng As Range
    
    Set Rng = ActiveDocument.Range
    
    With Rng.Find
        Do While .Execute(findText:="wqcdcompliance", Forward:=False) = True
        Rng.MoveEndUntil (" ")
            If Len(Rng.Text) > 1 Then
                ActiveDocument.Hyperlinks.Add _
                    Anchor:=Rng, _
                    Address:= "\" & Split(Replace(Rng.Text, "/", "\"), "\")(UBound(Split(Replace(Rng.Text, "/", "\"), "\"))), _
                    SubAddress:="", _
                    ScreenTip:="", _
                    TextToDisplay:=""
                Rng.Collapse wdCollapseStart
            End If
        Loop
    End With
End Sub