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