I have a macro that imports sheets from another workbook, then calls the below code to change any links on the imported sheets to the sheet of the same name in the active workbook. All sheets have the same names between the two books, with the exception of one which was changed between versions of the file at some point erroneously.
My issue is that when the code comes to a link to this differently named sheet, it stops and does not continue through the rest of the links. Is there a way I can have it break those links and continue on, or just delete the value in those cells?
Much of this code was made possible with help from this board. If in the meantime I work out a solution I'll be sure to post an update.
Thanks!
My issue is that when the code comes to a link to this differently named sheet, it stops and does not continue through the rest of the links. Is there a way I can have it break those links and continue on, or just delete the value in those cells?
Code:
Sub MyChangeLinkSource()
Dim varFileName As Variant
Dim arrLinks As Variant
Dim ws As Worksheet
Dim MyLink As String
Dim i As Long
'Object references
Set ws = ActiveSheet
'Check for links
arrLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If IsEmpty(arrLinks) Then
Exit Sub
End If
'Get new source file
varFileName = ActiveWorkbook.Name
If varFileName = "False" Then Exit Sub
'Error handler to re-protect workbook in case of errors
On Error GoTo Handler
' Add braces [] around file name
MyLink = Mid(varFileName, InStrRev(varFileName, "\") + 1)
varFileName = Replace(varFileName, MyLink, "[" & MyLink & "]")
'Change link source
arrLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
For i = 1 To UBound(arrLinks)
' Add braces [] around each link filename
MyLink = Mid(arrLinks(i), InStrRev(arrLinks(i), "\") + 1)
MyLink = Replace(arrLinks(i), MyLink, "[" & MyLink & "]")
' Replace old LinkSources file name with new
If Not ws.Cells.Find(MyLink, , xlFormulas) Is Nothing Then
ws.Cells.Replace What:=MyLink, Replacement:=varFileName, LookAt:=xlPart
End If
Next i
'Handle errors
Handler:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & vbCrLf & Err.Description & _
vbLf & vbLf & "There was an error linking prior period tabs to current workbook. Please click ok and review the new tabs."
End If
End Sub
Much of this code was made possible with help from this board. If in the meantime I work out a solution I'll be sure to post an update.
Thanks!