Results 1 to 4 of 4
  1. #1
    Star Lounger
    Join Date
    Jul 2008
    Posts
    68
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Help To Repair Broken Hyperlink (MS Office 2003)

    I have numerous broken hyperlinks in a txt document. I am accessing and processing the txt document using Word because Word permits me to use macros.

    This is the hyperlink as it should be

    <U>Mat 16:13-19</U>

    This is the broken and fractured hyperlink with repeated text.

    <U>Mat 16:13-19">Mat 16:13">Mat 16:13</a>-19</a></U>


    The broken and fractured hyperlinks contain Bible book, name, and verse references.
    There are 66 three letter book abbreviations, Gen, Exo, Levů etc.
    The chapter and verse numbers range from 1 to over 100.

    In the broken hyperlink, the book abbreviation appears four times rather than two times.
    In the broken hyperlink, the book and chapter numbers appear four times rather than two times.
    In the broken hyperlink, when a ranger of verse numbers appears using a dash (like Gen 3:2-7), the number to the right of the dash appears two times as would be expected.

    I need a macro and/or regular expression to take out the repeated text and numbers.

    Thank you in advance for any help and suggestions.

  2. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts

    Re: Help To Repair Broken Hyperlink (MS Office 2003)

    Wow, that's a mess. I cannot think of any automated way to clean up the end of the tag, and I'm reluctant to fix the easy part at the beginning because that's the best way to find the broken links.

  3. #3
    Silver Lounger
    Join Date
    Jul 2001
    Location
    Ottawa, Ontario, Canada
    Posts
    1,609
    Thanks
    0
    Thanked 1 Time in 1 Post

    Re: Help To Repair Broken Hyperlink (MS Office 2003)

    Try this
    <div style="width: 100%; background-color: #FFFFFF;"><code><font color=black>
    <font color=blue>Sub</font color=blue> FindLinks()
    <font color=blue>Dim</font color=blue> LnkSt <font color=blue>As</font color=blue> <font color=blue>Long</font color=blue>
    <font color=blue>Dim</font color=blue> LnkEnd <font color=blue>As</font color=blue> <font color=blue>Long</font color=blue>
    <font color=blue>Dim</font color=blue> strLink <font color=blue>As</font color=blue> <font color=blue>String</font color=blue>

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    <font color=blue>With</font color=blue> Selection.Find
    .Text = "<U>"
    .Replacement.Text = ""
    .Forward = <font color=blue>True</font color=blue>
    .Wrap = wdFindStop
    .Format = <font color=blue>False</font color=blue>
    .MatchCase = <font color=blue>False</font color=blue>
    .MatchWholeWord = <font color=blue>False</font color=blue>
    .MatchWildcards = <font color=blue>False</font color=blue>
    .MatchSoundsLike = <font color=blue>False</font color=blue>
    .MatchAllWordForms = <font color=blue>False</font color=blue>
    <font color=blue>End</font color=blue> <font color=blue>With</font color=blue>

    <font color=blue>Do</font color=blue>
    <font color=blue>With</font color=blue> Selection.Find
    .Text = "<U>"
    <font color=blue>End</font color=blue> <font color=blue>With</font color=blue>

    Selection.Find.Execute
    <font color=blue>If</font color=blue> <font color=blue>Not</font color=blue> Selection.Find.Found <font color=blue>Then</font color=blue>
    MsgBox "No more links found."
    <font color=blue>Exit</font color=blue> <font color=blue>Do</font color=blue>
    <font color=blue>End</font color=blue> <font color=blue>If</font color=blue>
    Selection.Collapse
    LnkSt = Selection.Start
    <font color=blue>With</font color=blue> Selection.Find
    .Text = "</U>"
    .Execute
    <font color=blue>End</font color=blue> <font color=blue>With</font color=blue>
    <font color=blue>If</font color=blue> <font color=blue>Not</font color=blue> Selection.Find.Found <font color=blue>Then</font color=blue>
    MsgBox "Link initiated, but not terminated."
    <font color=blue>Exit</font color=blue> <font color=blue>Do</font color=blue>
    <font color=blue>End</font color=blue> <font color=blue>If</font color=blue>
    LnkEnd = Selection.End
    strLink = ActiveDocument.Range(LnkSt, LnkEnd)
    ActiveDocument.Range(LnkSt, Lnk<font color=blue>End</font color=blue>).Select
    <font color=blue>Call</font color=blue> FindFault(strLink)
    Selection.TypeText strLink
    <font color=blue>Loop</font color=blue>
    <font color=blue>End</font color=blue> <font color=blue>Sub</font color=blue>

    <font color=blue>Public</font color=blue> <font color=blue>Sub</font color=blue> FindFault(strLink <font color=blue>As</font color=blue> <font color=blue>String</font color=blue>)
    <font color=blue>Dim</font color=blue> Suspects() <font color=blue>As</font color=blue> <font color=blue>Long</font color=blue>
    <font color=blue>Dim</font color=blue> Locn <font color=blue>As</font color=blue> Long
    Dim ctr As Long

    <font color=blue>ReDim</font color=blue> Suspects(1, 0)

    Locn = InStr(1, strLink, "</a>") + 4
    <font color=blue>Do</font color=blue> <font color=blue>While</font color=blue> Locn <> 4
    Suspects(0, <font color=blue>UBound</font color=blue>(Suspects, 2)) = Locn
    <font color=blue>ReDim</font color=blue> <font color=blue>Preserve</font color=blue> Suspects(1, <font color=blue>UBound</font color=blue>(Suspects, 2) + 1)
    Locn = InStr(Locn, strLink, "</a>") + 4
    <font color=blue>Loop</font color=blue>
    <font color=blue>If</font color=blue> <font color=blue>UBound</font color=blue>(Suspects, 2) = 1 <font color=blue>Then</font color=blue> <font color=blue>Exit</font color=blue> <font color=blue>Sub</font color=blue>

    <font color=blue>ReDim</font color=blue> <font color=blue>Preserve</font color=blue> Suspects(1, <font color=blue>UBound</font color=blue>(Suspects, 2) - 2)
    Locn = 0
    <font color=blue>For</font color=blue> ctr = <font color=blue>UBound</font color=blue>(Suspects, 2) <font color=blue>To</font color=blue> 0 <font color=blue>Step</font color=blue> -1
    Locn = InStrRev(Left(strLink, Suspects(0, ctr)), """>")
    Suspects(1, ctr) = Locn
    <font color=blue>Next</font color=blue> ctr

    <font color=blue>For</font color=blue> ctr = <font color=blue>UBound</font color=blue>(Suspects, 2) <font color=blue>To</font color=blue> 0 <font color=blue>Step</font color=blue> -1
    strLink = Left(strLink, Suspects(1, ctr) - 1) _
    & Right(strLink, Len(strLink) - Suspects(0, ctr) + 1)
    <font color=blue>Next</font color=blue> ctr

    End <font color=blue>Sub</font color=blue>

    </font color=black></code></div hiblock>
    Regards
    Don

  4. #4
    Star Lounger
    Join Date
    Jul 2008
    Posts
    68
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Help To Repair Broken Hyperlink (MS Office 2003)

    Thank you, Don. The macro works great. 5 Stars +++

    I freely give and will freely give to others just as you freely gave to me.

    Thank you again. Your help is truly appreciated.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •