Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Sub ExtractHyperlinks()
With ActiveDocument.Range
.Font.Hidden = True
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Style = "Hyperlink"
.Text = ""
.Replacement.Text = ""
.Replacement.Font.Hidden = False
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Font.Hidden = True
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Text = "[^13]{1,}"
.Execute Replace:=wdReplaceAll
End With
End With
End Sub
Function doHL()
Dim nd As Document
Dim a As Document
Dim h As Hyperlink
Dim r As Range
Application.ScreenUpdating = False
Set a = ActiveDocument
Set nd = Documents.Add
For Each h In a.Hyperlinks
Set r = nd.Range
r.Collapse
r.InsertParagraph
r.InsertAfter (h.Address)
Next
nd.Activate
Application.ScreenUpdating = True
Application.ScreenRefresh
End Function
[blue]'Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Sub GetHyperlinks()
Dim myDoc As Document
Dim wombat As Hyperlink
' Dim starttime As Long
Dim CurrentDoc As Document
Application.ScreenUpdating = False
Set CurrentDoc = ActiveDocument
Set myDoc = Application.Documents.Add()
' starttime = GetTickCount
For Each wombat In CurrentDoc.Hyperlinks
myDoc.Range.InsertAfter wombat.TextToDisplay & vbTab & wombat.Address & vbCrLf
Next
' Debug.Print GetTickCount - starttime
Application.ScreenUpdating = True
myDoc.Range.ParagraphFormat.TabStops.Add CentimetersToPoints(7.5), wdAlignTabLeft, wdTabLeaderSpaces 'basic formatting
End Sub
[/blue]
[blue]Sub ExtractHyperlinks()
Dim starttime As Long
Application.ScreenUpdating = False
starttime = GetTickCount
With ActiveDocument.Range
.Font.Hidden = True
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Style = "Hyperlink"
.Text = ""
.Replacement.Text = ""
.Replacement.Font.Hidden = False
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Font.Hidden = True
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Text = "[^13]{1,}"
.Execute Replace:=wdReplaceAll
End With
End With
Debug.Print GetTickCount - starttime
Application.ScreenUpdating = False
End Sub[/blue]