Macro which finds hyperlinks and replaces them as footnotes

rabauck · #1 10-25-2018, 09:23 AM

Hey there,

I have a lot of Word documents with a few hundred pages. They all contain hyperlinks but I want them to be footnotes.

I was wondering if there is a macro, that is searching for hyperlinks and deletes them and puts the anchor texts as footnotes.

Thank you!

macropod · #2 10-25-2018, 01:34 PM

Try the following macro:

Code:

Sub HLnk2FtNt()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String
Dim wdDoc As Document, h As Long, Rng As Range
strDocNm = ActiveDocument.FullName
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
      AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      For h = .Hyperlinks.Count To 1 Step -1
        With .Hyperlinks(h)
          Set Rng = .Range
          With Rng
            .Collapse wdCollapseEnd
            .Footnotes.Add Rng
            .End = .End + 1
          End With
          Rng.Footnotes(1).Range.FormattedText = .Range.FormattedText
          .Range.Text = vbNullString
        End With
      Next
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm

rabauck · #3 10-26-2018, 01:35 AM

I receive the following error message:
Run-time error '429': ActiveX component can't create object

When Debugged, it points to this line:

Code:

Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)

Any thoughts?

macropod · #4 10-26-2018, 04:02 AM

I suggest re-starting your PC and, if that fails, repairing the Office installation (via Windows Control Panel > Programs > Programs & Features > Microsoft Office (version) > Change > Repair).

rabauck · #5 10-26-2018, 06:58 AM

I still get the error. Maybe the point is that I use Mac OS. I read that Mac doesn't support the Dictionary object. Is this possible?

macropod · #6 10-26-2018, 12:49 PM

Quote:

Originally Posted by rabauck

Maybe the point is that I use Mac OS.

Indeed. And had you had a correct user profile when you posted the question, I wouldn't have bothered developing that code...

rabauck · #7 10-26-2018, 01:28 PM

I'm sorry for making thinks complicated and bothering for you. I didn't notice that I must have accidentally selected the wrong OS.

Is there still a way to get this kind of macro for mac? Or is there a variable I can use in the code below instead of "hello"? I found this code by gmayor on another thread.

Code:

Sub Hyperlink2Footnote()
Dim oRng As Range
Dim strText As String
Dim lngIndex As Long
  Set oRng = ActiveDocument.Range
  lngIndex = 1
  With oRng.Find
    While .Execute(FindText:="hello", _
                   MatchWildcards:=True, _
                   ReplaceWith:="\1")
      ActiveDocument.Footnotes.Add oRng, CStr(lngIndex), oRng.Text
      lngIndex = lngIndex + 1
      oRng.Text = vbNullString
      oRng.Collapse 0
    Wend
  End With
lbl_Exit:
  Set oRng = Nothing
  Exit Sub
End Sub

Thanks a lot!

macropod · #8 10-26-2018, 01:33 PM

Graham's code won't help. In any event, most of the code I posted will work on a Mac; just not the code related to looping through a folder & opening documents.

rabauck · #9 10-26-2018, 01:38 PM

Is there a code for mac which is doing the same? Or any other alternative?

macropod · #10 10-26-2018, 02:00 PM

Probably, but I don't use a Mac.

asteer · #11 10-08-2022, 11:37 AM

I have tried to run this macro - it just sits there - nothing happens - I'm using office 365 - word - have saved the document as doc instead of docx - I don't need it to go through folders - just want it to do one file with 500 plus hyperlinks which I'd like converted to footnotes

see example
In the 2018 Europe Write the Docs conference, Predrag Mandic demonstrated the ...

what I want to get is :

In the 2018 Europe Write the Docs conference, Predrag Mandic [1]
demonstrated the ...
________
[1] https://www.youtube.com/watch?v=oW7rWJ2xNZU

with Word consecutively numbering the footnotes and placing them at the bottom of the page

Please help

macropod · #12 10-21-2022, 03:55 PM

The code in post #2 works as described. Unlike your requirements, though, it deletes the hyperlink's 'click' text. You can preserve that by changing:

Code:

.Range.Text = vbNullString

to:

Code:

.Range.FieldsUnlink

For just the active document, you could use:

Code:

Sub HLnk2FtNt()
Application.ScreenUpdating = False
Dim h As Long, Rng As Range
With ActiveDocument
  For h = .Hyperlinks.Count To 1 Step -1
    With .Hyperlinks(h)
      Set Rng = .Range
      With Rng
        .Collapse wdCollapseEnd
        .Footnotes.Add Rng
        .End = .End + 1
      End With
      Rng.Footnotes(1).Range.FormattedText = .Range.FormattedText
      .Range.Fields.Unlink
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Word macro for selecting text and putting it in footnotes	mdhg	Word VBA	20	03-06-2024 08:07 AM
Is there a macro to convert superscripted endnotes to active footnotes?	mediadesign	Word VBA	4	08-20-2018 03:20 PM
creating manuscript w/footnotes from separate documents containing chapters with footnotes-word 2010	Dottie	Publisher	0	02-19-2017 03:18 PM
How can I create a macro to shift the content of all subsequent footnotes up one position?	Atfon	Word VBA	4	03-29-2016 05:51 AM
Word doesn't jumps tothe next lane when finds the dash sign!!!! why?	Jamal NUMAN	Word	3	04-10-2011 02:49 PM