Microsoft Office Forums - View Single Post - [Solved] Trying to create a macro to batch edit hyperlinks

excelledsoftware · 01-01-2015, 02:53 PM

Ok First and foremost we have to make your code readable. I have done this below.

The issue you were most likely experiencing was the duplicate sub names. I have adjusted this below as well. I would be surprised if this discovery fixes the issue but if it does not post a sample workbook with the desired result and I will be happy to figure this out for you.

Properly formatted code below.

Code:

Public Sub ReplaceHyperlinkURL(FindString As String, ReplaceString As String)
  Dim LinkURL, PreStr, PostStr, NewURL As String
  Dim FindPos, ReplaceLen, URLLen As Integer
  Dim MyDoc As Worksheet
  Dim MyCell As Range

  On Error GoTo ErrHandler
  Set MyDoc = ActiveSheet
  For Each MyCell In MyDoc.UsedRange
    If MyCell.Hyperlinks.Count > 0 Then
      LinkURL = MyCell(1).Hyperlinks(1).Address
      FindPos = InStr(1, LinkURL, FindString)
        If FindPos > 0 Then 'If FindString is found
          ReplaceLen = Len(FindString)
          URLLen = Len(LinkURL)
          PreStr = Mid(LinkURL, 1, FindPos - 1)
          PostStr = Mid(LinkURL, FindPos + ReplaceLen, URLLen)
          NewURL = PreStr & ReplaceString & PostStr
          MyCell(1).Hyperlinks(1).Address = NewURL 'Change the URL
        End If
      End If
    Next MyCell
    
Exit Sub
ErrHandler:   MsgBox ("ReplaceHyperlinkURL error")
End Sub

Sub RunReplaceURL()
  Call ReplaceHyperlinkURL("W:\", "E:\My Documents\")
End Sub

Thanks