Update hyperlink to document after folder path has changed

[jomuir]

Hi,

I have been asked to help a team that have a spreadsheet that “keeps on breaking”, I have figure out that they have hyperlinks linking to word documents, but at the end of the year these folders are all moved into a YEARS folder – resulting in all the hyperlinks breaking!

This is going back to 2010, so will need to do this for 2010 - 2015

I have searched online and found a few solutions, but I cannot get any of them to work for me, I have tried:

Sub FixHyperlinks()
Dim OldStr As String, NewStr As String
OldStr = "\\fs4\lations\OFFICE\Press Statements\"
NewStr = "\\fs4\lations\ OFFICE\Press Statements\Responses 2010\"
Dim hyp As hyperlink
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(expression:=hyp.Address, _
Find:=OldStr, _
Replace:=NewStr, _
compare:=vbTextCompare)
Next hyp
End Sub

Sub Fix192Hyperlinks()
Dim OldStr As String, NewStr As String
OldStr = "\\fs4\lations\OFFICE\Press Statements\"
NewStr = "\\fs4\lations\ OFFICE\Press Statements\Responses 2010\"
Dim hyp As hyperlink
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
End Sub

Any ideas what I am doing wrong?

 

[Gary McMaster]

Hi jomuir,

Welcome to the board.

If the space preceding the word "OFFICE" in your code is intentional I believe you may have to force in a non breaking space using the Chr function.

If you try to rename a folder in "Windows Explorer" to contain a leading space from the keyboard, the system wont allow the space bar Chr(32) which is what your NewStr variable probably contains. If the "OFFICE" folder really contains a leading space I believe that it is not possible for it to be Chr(32)

The complete table of ASCII characters, codes, symbols and signs, American Standard Code for Information Interchange, The complete ASCII table, characters,letters, vowels with accents, consonants, signs, symbols, numbers ascii, ascii art, ascii table

 

[Fishboy]

Hi,

I have been asked to help a team that have a spreadsheet that “keeps on breaking”, I have figure out that they have hyperlinks linking to word documents, but at the end of the year these folders are all moved into a YEARS folder – resulting in all the hyperlinks breaking!

This is going back to 2010, so will need to do this for 2010 - 2015

I have searched online and found a few solutions, but I cannot get any of them to work for me, I have tried:

Sub FixHyperlinks()
Dim OldStr As String, NewStr As String
OldStr = "\\fs4\lations\OFFICE\Press Statements\"
NewStr = "\\fs4\lations\ OFFICE\Press Statements\Responses 2010\"
Dim hyp As hyperlink
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(expression:=hyp.Address, _
Find:=OldStr, _
Replace:=NewStr, _
compare:=vbTextCompare)
Next hyp
End Sub

Sub Fix192Hyperlinks()
Dim OldStr As String, NewStr As String
OldStr = "\\fs4\lations\OFFICE\Press Statements\"
NewStr = "\\fs4\lations\ OFFICE\Press Statements\Responses 2010\"
Dim hyp As hyperlink
For Each hyp In ActiveSheet.Hyperlinks
hyp.Address = Replace(hyp.Address, OldStr, NewStr)
Next hyp
End Sub

Any ideas what I am doing wrong?

Hi jomuir, welcome to the boards.

Try out the following in a COPY of one of the workbooks. It probably wont be the fastest way of doing it, but it will at least do the job:

Sub UpdateLinks2()
' Define variables
Dim Cell As Range, cRange As Range
    ' Sets check range
    Set cRange = ActiveSheet.UsedRange
        ' For each cell in check range
        For Each Cell In cRange
            ' Update the link
            Cell.Replace What:="\\fs4\lations\OFFICE\Press Statements\", _
                    Replacement:="\\fs4\lations\OFFICE\Press Statements\Responses 2010\", LookAt _
                    :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
            ' Recreate the hyperlink
            ActiveSheet.Hyperlinks.Add Cell, Cell.Value
        Next Cell
End Sub

 

[jomuir]

Thank you both!

The space was a typo!

I just created a COPY and tried this code, but it made every cell become a hyperlink all going to \\fs4\lations\OFFICE\Press Statements\(Whatever text was in the cell). All the cells that were hyperlinks were not update to the new folder.....seems everything has become the Cell.Replace What:="\\fs4\lations\OFFICE\Press Statements\"

Any ideas?

I want only the cells with hyperlinks to be updated (ideally only cells highlighted, as need to do different years but I can copy different years into different sheets to do) all non hyperlinked cells to remain as is.

 

[Fishboy]

Thank you both!

The space was a typo!

I just created a COPY and tried this code, but it made every cell become a hyperlink all going to \\fs4\lations\OFFICE\Press Statements\(Whatever text was in the cell). All the cells that were hyperlinks were not update to the new folder.....seems everything has become the Cell.Replace What:="\\fs4\lations\OFFICE\Press Statements\"

Any ideas?

I want only the cells with hyperlinks to be updated (ideally only cells highlighted, as need to do different years but I can copy different years into different sheets to do) all non hyperlinked cells to remain as is.

Hi jomuir, sorry for the confusion. I will have to go back to the drawing board and come back to you later.

 

[jomuir]

Thank you!

 

[Fishboy]

Thank you!

Right, I have expanded upon my original code a bit....

Sub UpdateLinksNew()
' Define variables
Dim Cell As Range, cRange As Range
    ' Sets check range
    Set cRange = ActiveSheet.UsedRange
        ' For each cell in check range
        For Each Cell In cRange
            ' If the cell contains a hyperlink then...
            If Cell.Hyperlinks.Count > 0 Then
                ' If the hyperlink starts with "\\fs4\lations\OFFICE\Press Statements\" then...
                If Left(Cell.Value, 38) = "\\fs4\lations\OFFICE\Press Statements\" Then
                    ' Update the link
                    Cell.Replace What:="\\fs4\lations\OFFICE\Press Statements\", _
                            Replacement:="\\fs4\lations\OFFICE\Press Statements\Responses 2010\", LookAt _
                            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                            ReplaceFormat:=False
                    ' Recreate the hyperlink
                    ActiveSheet.Hyperlinks.Add Cell, Cell.Value
                End If
            End If
        Next Cell
End Sub

Firstly this checks if a cell has a hyperlink and if it doesn't it moves on. If the cell DOES have a hyperlink it then checks if the first 38 characters of the cell value are \\fs4\lations\OFFICE\Press Statements\, if it is not is moves on. If the cell value DOES start with \\fs4\lations\OFFICE\Press Statements\ then it appends Responses 2010\ to the end, before recreating the hyperlink based on the new cell value

 

[jomuir]

Right, I have expanded upon my original code a bit....

Sub UpdateLinksNew()
' Define variables
Dim Cell As Range, cRange As Range
    ' Sets check range
    Set cRange = ActiveSheet.UsedRange
        ' For each cell in check range
        For Each Cell In cRange
            ' If the cell contains a hyperlink then...
            If Cell.Hyperlinks.Count > 0 Then
                ' If the hyperlink starts with "\\fs4\lations\OFFICE\Press Statements\" then...
                If Left(Cell.Value, 38) = "\\fs4\lations\OFFICE\Press Statements\" Then
                    ' Update the link
                    Cell.Replace What:="\\fs4\lations\OFFICE\Press Statements\", _
                            Replacement:="\\fs4\lations\OFFICE\Press Statements\Responses 2010\", LookAt _
                            :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                            ReplaceFormat:=False
                    ' Recreate the hyperlink
                    ActiveSheet.Hyperlinks.Add Cell, Cell.Value
                End If
            End If
        Next Cell
End Sub

Firstly this checks if a cell has a hyperlink and if it doesn't it moves on. If the cell DOES have a hyperlink it then checks if the first 38 characters of the cell value are \\fs4\lations\OFFICE\Press Statements\, if it is not is moves on. If the cell value DOES start with \\fs4\lations\OFFICE\Press Statements\ then it appends Responses 2010\ to the end, before recreating the hyperlink based on the new cell value

This runs, but does not update the hyperlink, I tried adding wildcards in * but this did not work. It is not update all the fields anymore, but is not appending Responses 2010\

 

[Fishboy]

This runs, but does not update the hyperlink, I tried adding wildcards in * but this did not work. It is not update all the fields anymore, but is not appending Responses 2010\

Hmmm, HERE is my test document with the macro doing as described. Have a go and see if this works for you here. If it works here and not in your main workbook there there is something about your data layout / formatting that is different from mine that must be causing the issue. We wont know what til you try.

 

[jomuir]

Hmmm, HERE is my test document with the macro doing as described. Have a go and see if this works for you here. If it works here and not in your main workbook there there is something about your data layout / formatting that is different from mine that must be causing the issue. We wont know what til you try.

Sorry for the delay, I have not been in for a couple of days.

Yes, this works - the difference seems to be the full url in your cells, in my cells there is just text (the document name) not the full path - could this be what is making the difference?

I have created a sample of a field of the fields here if this helps?

Thank you!