changing links in a spreadsheet en mass

**oliverm** · 09-26-2011, 11:45 AM

hi chaps,

I've used this macro to find the list of links in a few of our spreadsheets;

http://www.exceltip.com/st/List,_cha...Excel/487.html

However I want to go one further and change any link with a double sharename in it (ie change it from \\servername\sharename\sharename\file to \\servername\sharename\file) after some doppy ***** here managed to corrupt 300+ links in almost 200+ spreadsheets with duff UNC paths.

Any ideas how I can do this or has someone got a script that can handle this that I could borrow?

Olly

**mrice** · 09-26-2011, 05:22 PM

This should work for al the hyperlinks in one sheet.

Sub Test()
Dim MyHyperlink As Hyperlink
Dim ContainsDouble As Boolean
For Each MyHyperlink In ActiveSheet.Hyperlinks
    MyArray = Split(MyHyperlink.Address, "\")
    ContainsDouble = False
    For N = 0 To UBound(MyArray) - 1
        If MyArray(N) = MyArray(N + 1) Then
            ContainsDouble = True
            Exit For
        End If
    Next N
    If ContainsDouble = True Then
        NewHyperLink = ""
        For M = 0 To UBound(MyArray)
            If M <> N Then
                NewHyperLink = NewHyperLink & MyArray(M) & "\"
            End If
        Next M
        NewHyperLink = Left(NewHyperLink, Len(NewHyperLink) - 1)
        MyHyperlink.Address = NewHyperLink
    End If
Next MyHyperlink
End Sub

If this works, it can be extended to multiple workbooks.