changelink with the name and new name as strings is failing
 

below is the code I am using and it is failing at the changelink command.
Any clues as to why? When I recorded a change link and then tested the
recording by change the xls names around it worked fine. Thanks in advance.

Sub Restorelinks()
Dim savefilename As String
Dim PATH, link As String
Set oldactive = ActiveSheet

Application.ScreenUpdating = False

Const iTitle = "Save Data File" ' title of dialog box
Const FilterList = "Microsoft Excel Workbook (*.xls),*.xls"
PATH = Application.GetSaveAsFilename(savefilename, FilterList, , iTitle)

On Error GoTo ErrorHandler
Worksheets("data").Visible = True
Worksheets("data").Select


aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
link = Chr(13) & aLinks(i)
Next i
End If

ActiveWorkbook.ChangeLink Name:=link, NewName:=PATH, Type:=xlExcelLinks


Worksheets("data").Visible = False
oldactive.Select
Application.ScreenUpdating = True

ErrorHandler:
If Err.Number < 0 Then
MsgBox "error occured"
Exit Sub
End If
End Sub

changelink with the name and new name as strings is failing
 

I figured it out. If you remove the Chr(13) & from [link = Chr(13) &
aLinks(i)] below the macro works perfect.

--
Thanks!
Shane W


"whylite" wrote:

below is the code I am using and it is failing at the changelink command.
Any clues as to why? When I recorded a change link and then tested the
recording by change the xls names around it worked fine. Thanks in advance.

Sub Restorelinks()
Dim savefilename As String
Dim PATH, link As String
Set oldactive = ActiveSheet

Application.ScreenUpdating = False

Const iTitle = "Save Data File" ' title of dialog box
Const FilterList = "Microsoft Excel Workbook (*.xls),*.xls"
PATH = Application.GetSaveAsFilename(savefilename, FilterList, , iTitle)

On Error GoTo ErrorHandler
Worksheets("data").Visible = True
Worksheets("data").Select


aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
link = Chr(13) & aLinks(i)
Next i
End If

ActiveWorkbook.ChangeLink Name:=link, NewName:=PATH, Type:=xlExcelLinks


Worksheets("data").Visible = False
oldactive.Select
Application.ScreenUpdating = True

ErrorHandler:
If Err.Number < 0 Then
MsgBox "error occured"
Exit Sub
End If
End Sub