Auto changing links between workbook in formulas - excel

Question

I have code that auto changes formula links from another workbook.
On my laptop (Windows 10 office 365) I get a runtime error and asks me to debug the following line.
ThisWorkbook.ChangeLink Name:=strLink, NewName:=strLinkNew, Type:=xlExcelLinks
It runs on a computer running windows 7 Office 2010.
The whole code:
Dim strFile As String
Dim aLinks As Variant
Dim i As Long
Dim strLink As String
Dim strLinkNew As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
strLinkNew = .SelectedItems(1)
aLinks = ThisWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
strLink = aLinks(i)
If strLink Like "*\CRiSP*.xlsm" Then
'Change Linked File
Sheets("Links").Select
ThisWorkbook.Worksheets("Links").Unprotect "MYPASSWORD"
ThisWorkbook.ChangeLink Name:=strLink, NewName:=strLinkNew, Type:=xlExcelLinks
ThisWorkbook.Worksheets("Links").Protect "MYPASSWORD"
End If
Next
End If
End If
End With
Sheets("Main Menu").Select
Cells(1, 1).Select
Dim flToSave As Variant
Dim flName As String
Dim flFormat As Long
flFormat = ActiveWorkbook.FileFormat
flName = Range("A1") & Range("A2").Text
flToSave = Application.GetSaveAsFilename _
(ThisWorkbook.Path & "\" & flName, filefilter:="Excel Files (*.xlsm), *.xlsm", _
Title:="Save FileAs...")
If flToSave = False Then
Exit Sub
Else
ThisWorkbook.SaveAs Filename:=flToSave, FileFormat:=flFormat
End If
End Sub

Answer 1

I had the same error 1004 challenge but solved it by ensuring that both the 'Name' and 'NewName' files were present at their paths.

Answer 2

this function will update the links while at the same time fixes a strange bug i was trying to stomp on for a while, if a link is not used in the active sheet then excel gives you error 1004
'''''''''''''''''
Private Function UpdateXlsLinkSource(oldLinkPathAndFile As String, newLinkPathAndFile As String) As Boolean
UpdateXlsLinkSource = False
Dim lSources As Variant
lSources = ThisWorkbook.LinkSources(xlExcelLinks) 'array that contains all the links with path to excel files
Dim FILE_NAME As String
FILE_NAME = Right(newLinkPathAndFile, Len(newLinkPathAndFile) - InStrRev(newLinkPathAndFile, "\")) 'name of the file without path
Dim theFileIsAlreadyOpen As Boolean
theFileIsAlreadyOpen = file_open_module.IsWorkBookOpen(FILE_NAME) 'will check if the file is is open and return true or false
'check if a file with the same name is already open
If theFileIsAlreadyOpen Then
newLinkPathAndFile = Workbooks(FILE_NAME).PATH & "\" & Workbooks(FILE_NAME).Name 'use the open file
Else
Workbooks.Open FileName:=newLinkPathAndFile 'open the file if it wasn't already open
End If
theFileIsAlreadyOpen = True
'CHECK IF THE FILE NEEDS UPDATING
If newLinkPathAndFile = oldLinkPathAndFile Then
UpdateXlsLinkSource = True 'if the link is unchanged update the values
Exit Function
Else
'step thru the existing links and see if it exists
For Each Link In lSources
If Link = oldLinkPathAndFile Then
'''''''''''''''''''''''''''''''''''''
For Each SHEET In ThisWorkbook.Worksheets 'this seemingly useless loop handles a bug where if a link is not referenced in the active sheet it crashes
SHEET.Activate
On Error Resume Next
'''''''''''''''''''''''''''''''''''''
ThisWorkbook.Activate
ThisWorkbook.ChangeLink Name:=Link, NewName:=newLinkPathAndFile, Type:=xlExcelLinks 'update the link
UpdateXlsLinkSource = True
'''''''''''''''''''''''''''''''''''''
If Err = 0 Then
On Error GoTo 0
Exit For
End If
Next SHEET
'''''''''''''''''''''''''''''''''''''
Exit For
End If
Next Link
'check if the link was found AND WARN IF IT WAS NOT
If Not UpdateXlsLinkSource Then
MsgBox "Link to target not found"
Exit Function
End If
If Not theFileIsAlreadyOpen Then 'CHECK IF THE FILE IS CLOSED, IF IT IS THEN OPEN IT
Workbooks.Open (newLinkPathAndFile)
End If
End If
End Function
'''''''''''''