Hyperlinks. MS Word. Looping through and modifying each as needed

[bobbyrjw]

I have a word doc with 800 hyperlinks. The owner wants ugly long hyperlinks display text to be short.
I have written this code to loop through the links and display on a userform;
the hyperlink address in textbox 1
the hyperlink display text in textbox 4
I have an input box that asks for the replacement display text.
I want it to put the input box text into userform textbox 5.
The big problem is the input box.

I need to use the textbox like the input box, and I need the code to take the the input and modify the link. I will get to that.
I just want it to let me put text in the box and assign the value to a variable, and then do the next.

Thank you very much - I don't know ther proper way to insert code here.

///////////////////////////////////////////////////////////////////////////////////////


Public i As Integer
Sub aaaaastart_fix()
Dim doc As Document
Dim newdisp As String
Dim link
Dim r As Range
Set doc = ActiveDocument
UserForm1.Show vbModeless
Set doc = ActiveDocument


For i = 1 To doc.Hyperlinks.Count
Application.ScreenUpdating = True


If Left(doc.Hyperlinks(i).Address, 3) = "www" Or Left(doc.Hyperlinks(i).Address, 3) = "htt" Then


UserForm1.TextBox3.Value = i
UserForm1.TextBox1.Value = doc.Hyperlinks(i).Address
UserForm1.TextBox4.Value = doc.Hyperlinks(i).TextToDisplay
UserForm1.TextBox5.Value = ""
UserForm1.TextBox5.SetFocus
newdisp = InputBox("Enter Link Display text")
ActiveDocument.ActiveWindow.SmallScroll Down:=1
UserForm1.TextBox5.Value = newdisp ' *the box is not updated!*
End If


Next

[gmayor]

You don't need an input box. That's what the text box is for.

Add two command buttons to your userform - 1 to quit and the other to change the value.
Code the userform as follows


Option Explicit

Private Sub CommandButton1_Click()
If TextBox5.Text = "" Then
TextBox5.Text = TextBox4.Text
End If
Selection.Hyperlinks.Item(1).TextToDisplay = TextBox5.Text
Unload Me
End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub




The main code loop is as follows



Option Explicit

Sub aaaaastart_fix()
Dim i As Integer
Dim doc As Document
Dim newdisp As String
Dim link
Dim r As Range
Dim oFrm As UserForm1


Set doc = ActiveDocument


For i = 1 To doc.Hyperlinks.Count
doc.Hyperlinks(i).Range.Select
Set oFrm = New UserForm1
If Left(doc.Hyperlinks(i).Address, 3) = "www" Or Left(doc.Hyperlinks(i).Address, 3) = "htt" Then
With oFrm
.TextBox3.Value = i
.TextBox4.Value = doc.Hyperlinks(i).TextToDisplay
.TextBox5.Value = ""
.TextBox5.SetFocus
.Show
End With
End If
Next i
End Sub

[macropod]

I don't know ther proper way to insert code here.
You do that by inserting a set of code tags into your post, via the # button on the posting menu, then inserting your code between them.

[bobbyrjw]

Thank you!

[bobbyrjw]

Thank you very much. Lots to see in your code.

[gmaxey]

Here is another way that uses a single form.

Add a userform with a label lblIndex, a spinbutton SpinButton1, a label lblAddress, a textbox txtDisplay and a command button cmdSet

In the form add this code:


Option Explicit
Private colLinks As New Collection
Private Sub UserForm_Activate()
Dim lngIndex As Long
For lngIndex = 1 To ActiveDocument.Hyperlinks.Count
'Add qualified hyperlinks to the collection
If Left(ActiveDocument.Hyperlinks(lngIndex).Address, 3) = "www" Or _
Left(ActiveDocument.Hyperlinks(lngIndex).Address, 3) = "htt" Then
colLinks.Add ActiveDocument.Hyperlinks(lngIndex)
End If
Next
If colLinks.Count > 0 Then
lblIndex.Caption = 1
lblIndex_Change
Else
MsgBox "There are no qualified links to process."
Unload Me
End If
lbl_Exit:
Exit Sub
End Sub
Private Sub lblIndex_Change()
'This is a psuedo event
colLinks.Item(Val(lblIndex)).Range.Select
lblAddress = colLinks.Item(Val(lblIndex)).Address
cmdSet.SetFocus
With txtDisplay
.Text = colLinks.Item(Val(lblIndex)).TextToDisplay
.SelStart = 0
.SelLength = Len(.Text)
.SetFocus
End With
cmdSet.Caption = "SET\NEXT"
If colLinks.Count = lblIndex Then cmdSet.Caption = "SET"
lbl_Exit:
Exit Sub
End Sub
Private Sub cmdSet_Click()
colLinks.Item(Val(lblIndex)).TextToDisplay = txtDisplay
If cmdSet.Caption = "SET" Then
Unload
Else
lblIndex = 1
lblIndex_Change
End If
lbl_Exit:
Exit Sub
End Sub
Private Sub SpinButton1_SpinUp()
If Val(lblIndex) < colLinks.Count Then
lblIndex = lblIndex + 1
Else
lblIndex = 1
End If
lblIndex_Change
lbl_Exit:
Exit Sub
End Sub
Private Sub SpinButton1_SpinDown()
If Val(lblIndex) > 1 Then
lblIndex = lblIndex - 1
Else
lblIndex = colLinks.Count
End If
lblIndex_Change
lbl_Exit:
Exit Sub
End Sub


In a standard module add this code:


Sub EditWebLinks()
Dim oFrm As UserForm1
Set oFrm = New UserForm1
oFrm.Show vbModeless
lbl_Exit:
Exit Sub
End Sub

[bobbyrjw]

Thank you - how to mark it solved?


You don't need an input box. That's what the text box is for.

Add two command buttons to your userform - 1 to quit and the other to change the value.
Code the userform as follows


Option Explicit

Private Sub CommandButton1_Click()
If TextBox5.Text = "" Then
TextBox5.Text = TextBox4.Text
End If
Selection.Hyperlinks.Item(1).TextToDisplay = TextBox5.Text
Unload Me
End Sub


Private Sub CommandButton2_Click()
Unload Me
End Sub




The main code loop is as follows



Option Explicit

Sub aaaaastart_fix()
Dim i As Integer
Dim doc As Document
Dim newdisp As String
Dim link
Dim r As Range
Dim oFrm As UserForm1


Set doc = ActiveDocument


For i = 1 To doc.Hyperlinks.Count
doc.Hyperlinks(i).Range.Select
Set oFrm = New UserForm1
If Left(doc.Hyperlinks(i).Address, 3) = "www" Or Left(doc.Hyperlinks(i).Address, 3) = "htt" Then
With oFrm
.TextBox3.Value = i
.TextBox4.Value = doc.Hyperlinks(i).TextToDisplay
.TextBox5.Value = ""
.TextBox5.SetFocus
.Show
End With
End If
Next i
End Sub

[bobbyrjw]

Thank you, this is over my head. I am going to print it and figure it out.


Here is another way that uses a single form.

Add a userform with a label lblIndex, a spinbutton SpinButton1, a label lblAddress, a textbox txtDisplay and a command button cmdSet

In the form add this code:


Option Explicit
Private colLinks As New Collection
Private Sub UserForm_Activate()
Dim lngIndex As Long
For lngIndex = 1 To ActiveDocument.Hyperlinks.Count
'Add qualified hyperlinks to the collection
If Left(ActiveDocument.Hyperlinks(lngIndex).Address, 3) = "www" Or _
Left(ActiveDocument.Hyperlinks(lngIndex).Address, 3) = "htt" Then
colLinks.Add ActiveDocument.Hyperlinks(lngIndex)
End If
Next
If colLinks.Count > 0 Then
lblIndex.Caption = 1
lblIndex_Change
Else
MsgBox "There are no qualified links to process."
Unload Me
End If
lbl_Exit:
Exit Sub
End Sub
Private Sub lblIndex_Change()
'This is a psuedo event
colLinks.Item(Val(lblIndex)).Range.Select
lblAddress = colLinks.Item(Val(lblIndex)).Address
cmdSet.SetFocus
With txtDisplay
.Text = colLinks.Item(Val(lblIndex)).TextToDisplay
.SelStart = 0
.SelLength = Len(.Text)
.SetFocus
End With
cmdSet.Caption = "SET\NEXT"
If colLinks.Count = lblIndex Then cmdSet.Caption = "SET"
lbl_Exit:
Exit Sub
End Sub
Private Sub cmdSet_Click()
colLinks.Item(Val(lblIndex)).TextToDisplay = txtDisplay
If cmdSet.Caption = "SET" Then
Unload
Else
lblIndex = 1
lblIndex_Change
End If
lbl_Exit:
Exit Sub
End Sub
Private Sub SpinButton1_SpinUp()
If Val(lblIndex) < colLinks.Count Then
lblIndex = lblIndex + 1
Else
lblIndex = 1
End If
lblIndex_Change
lbl_Exit:
Exit Sub
End Sub
Private Sub SpinButton1_SpinDown()
If Val(lblIndex) > 1 Then
lblIndex = lblIndex - 1
Else
lblIndex = colLinks.Count
End If
lblIndex_Change
lbl_Exit:
Exit Sub
End Sub


In a standard module add this code:


Sub EditWebLinks()
Dim oFrm As UserForm1
Set oFrm = New UserForm1
oFrm.Show vbModeless
lbl_Exit:
Exit Sub
End Sub