Trapping Erros on ChangeLinks
I have written this code which changes the links on a workbook in a preset
drive\filepath\location to the workbook which initiated the
"ResetBaseLedgerLinksToCurrentWorkbook" macro. The purpose of the error
trapping is to prevent the end user from resetting the link to the workbook
to which the link already exists. If the link already exists it seems to be
removing the link information. There is only one link source for the file
although there are thousands of cells linked between the two workbooks -
there is only one source at a time.
For example: if the link is to workbook "XYZ" and that is the current link,
it seems to remove that link, not replace it. What I ended up with is a huge
mass of circular references.
So I wrote the below. I'm not sure if I covered all my bases. Any
suggestions would be appreciated on how to trap for all of the potential
errors.
Option Explicit
Sub ResetBaseLedgerLinksToCurrentWorkbook()
' Reset the PFUL2005Ledger Links To Current Workbook
Dim varNewLinkName As Variant
Dim varOldLinkName As Variant
Dim varOldLinks As Variant
Dim wbConceptWorkbook As Workbook
Dim wbComplianceWorkbook As Workbook
Set wbConceptWorkbook = ThisWorkbook
wbConceptWorkbook.Activate
Worksheets("Inputs").Calculate
varNewLinkName = Worksheets("Inputs").Range("A90").Value
Set wbComplianceWorkbook = Workbooks("PFUL2005Ledger.xls")
varOldLinks = wbComplianceWorkbook.LinkSources
varOldLinkName = varOldLinks(1)
If varOldLinkName = varNewLinkName Then
GoTo NoChange
Else
On Error GoTo ErrorOnChange
wbComplianceWorkbook.ChangeLink Name:=varOldLinkName, NewName:= _
varNewLinkName, Type:=xlExcelLinks
wbConceptWorkbook.Activate
wbConceptWorkbook.Worksheets("Inputs").Range("A89" ).Select
Worksheets("Inputs").Calculate
wbConceptWorkbook.Worksheets("Inputs").Range("A1") .Select
End If
NoChange:
Set wbComplianceWorkbook = Nothing
Set wbConceptWorkbook = Nothing
Exit Sub
ErrorOnChange:
MsgBox "Error in changing links"
GoTo NoChange
End Sub
|