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?

 

[Fishboy]

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!

Hmm, that could well be causing the issue. I have tried downloading your sample document but it wont let me. Can you check the permissions on the file?

 

[jomuir]

Hmm, that could well be causing the issue. I have tried downloading your sample document but it wont let me. Can you check the permissions on the file?

Strange, here is the full url: https://www.dropbox.com/s/vcd103neh9p7xu3/jomuir.xlsm?dl=0

https://www.dropbox.com/s/vcd103neh9p7xu3/jomuir.xlsm?dl=0

 

[Fishboy]

Strange, here is the full url: https://www.dropbox.com/s/vcd103neh9p7xu3/jomuir.xlsm?dl=0

https://www.dropbox.com/s/vcd103neh9p7xu3/jomuir.xlsm?dl=0

Ok that link actually works.

I will have a look at the file and get back to your shortly.

 

[Fishboy]

Ok that link actually works.

I will have a look at the file and get back to your shortly.

Is this any better for you?

Sub UpdateLinksNew_Fishboy_Test()
' Define variables
Dim Cell As Range, cRange As Range, OldLink As String, NewLink As String
    ' Disables screen updating to reduce flicker
    Application.ScreenUpdating = False
        ' 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
                    ' Update variable OldLink with trhe hyperlink address
                    OldLink = Cell.Hyperlinks.Item(1).Address
                        ' If the hyperlink address starts with "\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\" then...
                        If Left(OldLink, 55) = "\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\" Then
                            ' Update cell XFD of the cell row with the old link
                            Range("XFD" & Cell.Row).Value = OldLink
                                ' Update the value in XFD of the cell row with the corrected hyperlink address
                                Range("XFD" & Cell.Row).Replace What:="\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\", _
                                        Replacement:="\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\Responses 2010\", LookAt _
                                        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                        ReplaceFormat:=False
                                    ' Update variable NewLink with the new address
                                    NewLink = Range("XFD" & Cell.Row).Value
                                        'Recreate the hyperlink
                                        Cell.Hyperlinks.Add Cell, NewLink
                                            ' Clear the content from cell XFD of the cell row
                                            Range("XFD" & Cell.Row).ClearContents
                        End If
                End If
            ' Check next cell in range
            Next Cell
    ' Re-enable screen updating
End Sub

 

[jomuir]

Is this any better for you?

Sub UpdateLinksNew_Fishboy_Test()
' Define variables
Dim Cell As Range, cRange As Range, OldLink As String, NewLink As String
    ' Disables screen updating to reduce flicker
    Application.ScreenUpdating = False
        ' 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
                    ' Update variable OldLink with trhe hyperlink address
                    OldLink = Cell.Hyperlinks.Item(1).Address
                        ' If the hyperlink address starts with "\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\" then...
                        If Left(OldLink, 55) = "\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\" Then
                            ' Update cell XFD of the cell row with the old link
                            Range("XFD" & Cell.Row).Value = OldLink
                                ' Update the value in XFD of the cell row with the corrected hyperlink address
                                Range("XFD" & Cell.Row).Replace What:="\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\", _
                                        Replacement:="\\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\Responses 2010\", LookAt _
                                        :=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                                        ReplaceFormat:=False
                                    ' Update variable NewLink with the new address
                                    NewLink = Range("XFD" & Cell.Row).Value
                                        'Recreate the hyperlink
                                        Cell.Hyperlinks.Add Cell, NewLink
                                            ' Clear the content from cell XFD of the cell row
                                            Range("XFD" & Cell.Row).ClearContents
                        End If
                End If
            ' Check next cell in range
            Next Cell
    ' Re-enable screen updating
End Sub

Thank you very much for all your time on this - unfortunately this is still not working.

 

[Fishboy]

Thank you very much for all your time on this - unfortunately this is still not working.

Hmmm, it seemed to work again at this end, even using your template document.

I have uploaded my updated version of it HERE so you can see if it works in that.

 

[jomuir]

This works for me too.....

I have just tried copying my data to your version to see if there was an issue with my document, but it still did not work. My live document does have a lot more fields (columns) but I cannot see how that would make a difference???

I will be splitting it into years once it si working as it uses the correct folder i.e. Responses 2010, Responses 2011 etc

here is a copy of the actual file: https://www.dropbox.com/s/pa732lz3joof5dl/Statement log - Jomuir.xlsm?dl=0

Any thoughts?

 

[Fishboy]

This works for me too.....

I have just tried copying my data to your version to see if there was an issue with my document, but it still did not work. My live document does have a lot more fields (columns) but I cannot see how that would make a difference???

I will be splitting it into years once it si working as it uses the correct folder i.e. Responses 2010, Responses 2011 etc

here is a copy of the actual file: https://www.dropbox.com/s/pa732lz3joof5dl/Statement log - Jomuir.xlsm?dl=0

Any thoughts?

OK, so the first thing I notice in your actual file is the links are not what you said they would be and therefore each cell it looks at will be skipped meaning nothing gets changed.

I was expecting all of the links to start with \\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\ however they actually all started with just Press Statements. Also for some reason it shows as forward slashes instead of back slashes. I included in a step where the existing link pops up in a message box (this allowed me to confirm what the links really were) and modified the code accordingly. As and when you are happy that this is working you can simply remove the whole middle section of the new macro to get rid of this step. I have separated this middle section out to make it easier to find.

HERE is my updated version of your latest file, try running the macro that ends with Testing instead of just Test

Let me know how you get on with this new file.

 

[jomuir]

OK, so the first thing I notice in your actual file is the links are not what you said they would be and therefore each cell it looks at will be skipped meaning nothing gets changed.

I was expecting all of the links to start with \\wdcfs4\publicrelations\PRESS OFFICE\Press Statements\ however they actually all started with just Press Statements. Also for some reason it shows as forward slashes instead of back slashes. I included in a step where the existing link pops up in a message box (this allowed me to confirm what the links really were) and modified the code accordingly. As and when you are happy that this is working you can simply remove the whole middle section of the new macro to get rid of this step. I have separated this middle section out to make it easier to find.

HERE is my updated version of your latest file, try running the macro that ends with Testing instead of just Test

Let me know how you get on with this new file.

Started linking to my C:Drive, but figured out need to save it to the actual location and then it all worked!!

Thank you so much for all your time!!

 

[Fishboy]

Started linking to my C:Drive, but figured out need to save it to the actual location and then it all worked!!

Thank you so much for all your time!!

I knew we would get there in the end!

Happy to help.