Remove external links from Excel workbook

Question

I've got a workbook that is saying there are external links in the workbook. Break links isn't actually breaking the link(s), so I've been working to create a macro to search for external references and remove them.

I've got the below so far and it runs & I haven't found any links to remove, but the prompt is still popping up when I open the workbook in question.

Public Sub Full_External_Link_Removal()
'
Dim WB As Workbook
Set WB = ActiveWorkbook
Dim cs As Worksheet
Dim NR As Name

'Iterate through named ranges on the workbook
For Each NR In WB.Names
    Named_Range_Ext_Link_Chk NR, ActiveSheet, WB
Next

'Iterate through sheets
For Each cs In WB.Sheets

    'Check the sheet's named ranges
    For Each NR In cs.Names
        Named_Range_Ext_Link_Chk NR, cs, WB
    Next
    
    'Check the formulas
    Sht_Formula_Check cs
    
    'Check the hyperlinks
    Sht_Hyperlinks_Check cs
    
    'Check the objects/shapes
    Sht_Shapes_Check cs
        
Next

End Sub


'Check the provided Named Range definition for an external file reference
Public Function Contains_File_Link(Chk_Str As String) As Boolean
'
Dim ret As Boolean
ret = False

If InStr(1, Chk_Str, ".xl", vbTextCompare) > 0 Then
    ret = True
End If

Contains_File_Link = ret
End Function


'Handles cleaning up Named Ranges
Public Sub Named_Range_Ext_Link_Chk(NR As Name, WS As Worksheet, WB As Workbook)
'
Dim temp_1 As String
Dim temp_2 As String

'Make sure the temporary strings start empty
temp_1 = ""
temp_2 = ""

'Get the definition of the Named Range
temp_1 = NR.RefersTo

'Check if the name's definition is an external link
If Contains_File_Link(temp_1) Then
    
    'Check how to handle that
    If MsgBox("External link found in Named Range '" & NR.Name & "'. The range is defined as '" & temp_1 & "'. Should this range be deleted?", vbYesNo, _
        "External Link in Named Range") = vbYes Then
    
        NR.Delete
    
    Else
    
        'Update the named range if needed
        temp_2 = Ext_Text_Update(temp_1, "named range", WS.Name)
        
        'Apply the definition
        NR.RefersTo = temp_2
                    
    End If 'else there's no external reference to clean up/delete, move to next range
End If

End Sub


'Routine to check all formulas on the given sheet for external links
Public Sub Sht_Formula_Check(WS As Worksheet)
'
Dim temp_1 As String
Dim temp_2 As String
Dim Trgt_Cells As Range
Dim TC As Range
Dim First_Address As String

'Make sure the Target cells is empty, and that the first_address value is empty
Set Trgt_Cells = Nothing
First_Address = ""

'Check the formulas
With WS.UsedRange
    Set Trgt_Cells = .Find(what:="*.xl*", LookIn:=xlFormulas)
    
    If (Not Trgt_Cells Is Nothing) Then
    
        'Loop through the cells
        Do While (Not Trgt_Cells Is Nothing) And First_Address <> Trgt_Cells.Address
            'Capture the first address (if we haven't already) to avoid infinite looping
            If First_Address = "" Then
                First_Address = Trgt_Cells.Address
            End If 'else we already have the first cell and no action needed
            
            'Capture the current cell for reference
            TC = WS.Range(Trgt_Cells.Address)
            
            'Update the formula if needed
            TC.Formula = Ext_Text_Update(TC.Formula, "cell formula", WS.Name)
            
            'move to the next match
            Set Trgt_Cells = .FindNext(Trgt_Cells)
        Loop
    End If 'else no formulas with external links found
    
End With

End Sub


'Routine to check all hyperlinks on the given sheet for external links
Public Sub Sht_Hyperlinks_Check(WS As Worksheet)
'
Dim hLink As Hyperlink
Dim temp_1 As String
Dim temp_2 As String

'Check the hyperlinks
For Each hLink In WS.Hyperlinks
    'Update the path if needed
    If hLink.Address <> "" Then
        hLink.Address = Ext_Text_Update(hLink.Address, "hyperlink", WS.Name)
    End If
    If hLink.SubAddress <> "" Then
        hLink.SubAddress = Ext_Text_Update(hLink.SubAddress, "hyperlink", WS.Name)
    End If
    
Next

End Sub


'Routine to check all shapes on the given sheet for external links
Public Sub Sht_Shapes_Check(WS As Worksheet)
'
Dim S As Shape

'Check the shapes
For Each S In WS.Shapes
    
    'Update the name if needed
    S.Name = Ext_Text_Update(S.Name, "shape name", WS.Name)
    
    'Update the hyperlink
    If HasHyperlink(S) Then
        If S.Hyperlink.Address <> "" Then
            S.Hyperlink.Address = Ext_Text_Update(S.Hyperlink.Address, "shape hyperlink path", WS.Name)
        End If
        
        If S.Hyperlink.SubAddress <> "" Then
            S.Hyperlink.SubAddress = Ext_Text_Update(S.Hyperlink.SubAddress, "shape hyperlink path", WS.Name)
        End If
    End If
Next

End Sub


'Generalized function to elicite and capture updates to formulas/paths/etc. that can't be automatically cleaned up
Public Function Ext_Text_Update(Orig_Str As String, Obj_Type As String, Src_Sht As String) As String
'
Dim temp_1 As String
Dim temp_2 As String
    
'Check if it has an external reference in the input string
If Contains_File_Link(Orig_Str) Then
    temp_1 = Orig_Str
    
    If MsgBox("Does the following " & LCase(Obj_Type) & " from " & Src_Sht & " need updated?" & Chr(10) & Chr(10) & temp_1, vbYesNo, _
        StrConv(Obj_Type, vbProperCase) & " Needing Updated?") = vbYes Then
        
        Do While temp_2 = ""
            temp_2 = InputBox("Update the " & LCase(Obj_Type) & " as needed", "External Link in " & StrConv(Obj_Type, vbProperCase), temp_1)
            
            Select Case temp_2
                Case "", " "
                    If MsgBox("Update to the " & LCase(Obj_Type) & " cancelled. Is the " & LCase(Obj_Type) & " actually fine as-is?", vbYesNo, _
                        "Cancel " & StrConv(Obj_Type, vbProperCase) & " Update") = vbNo Then
                        'Make sure we loop back to the input box
                        temp_2 = ""
                    Else
                        
                        'Set temp_2 to temp_1 to allow the in the calling sub to proceed normally
                        temp_2 = temp_1
                    End If
                    
                Case Else
                    If temp_2 = temp_1 Then
                        'No change made
                        MsgBox "No change made. Please update the " & LCase(Obj_Type) & " to remove the external link.", vbOKOnly, "Please Actually Change the " _
                            & StrConv(Obj_Type, vbProperCase)
                        temp_2 = ""
                    End If 'else take the value as is
            End Select
        Loop
    End If
End If 'else there's nothing to update

'Make sure we always pass something back
If temp_2 = "" Then
    temp_2 = Orig_Str
End If 'else it's populated and we're fine

Ext_Text_Update = temp_2
End Function


'Check if a hyperlink exists
Public Function HasHyperlink(shpTarget As Shape) As Boolean
'
Dim hLink As Hyperlink
Set hLink = Nothing

On Error Resume Next

Set hLink = shpTarget.Hyperlink
On Error GoTo 0

HasHyperlink = Not (hLink Is Nothing)
End Function

I'm not really sure where else to look, or if I'm missing links with the logic above how I could be. Any ideas to make the above checks more robust, or other places to look would be much appreciated.

Answer 1

My go-to when I realize that the external links could be anywhere (even in conditional formats) is this findlink add-in: https://www.manville.org.uk/software/findlink.htm

Usually I do the normal searches and then start searching the internet until I remember that I have this installed. It has not failed me.

Answer 2

To view all the links in your workbook you can use Workbook.LinkSources which holds the references.

if you are on windows there are 2 types of links :

1. Excel workbooks links "xlExcelLinks"
2. OLE objects links "xlOLELinks"(Added from insert -> Text -> objects)

Mac also got its specific type of links.

you use Workbook.BreakLink to remove the reference and turn it into a value

Option Explicit

'Use:the function takes 2 optional arguments , the workbook you want to remove or view its links and a True/false if you want to remove the links
'if no arguments are passed:it assumes the "thisworkbook" and false
Function FixLinks(Optional ByRef WB As Workbook, Optional ByVal RmvLnk As Boolean = False) As Boolean
    Dim ExclLnks() As Variant, OLElnks As Variant                   'Array to hold the links
    Dim ArrBegin As Long, ArrEnd As Long, i As Long                 'Array scope and iteration
    Dim result As Boolean
    
    If WB Is Nothing Then                                           'if you don't specify a workbook it assumes the current
        Set WB = ThisWorkbook
    End If
    result = False
    
    If Not IsEmpty(WB.LinkSources(xlExcelLinks)) Then               'Checks if there's any linked workbook
        ExclLnks = WB.LinkSources(xlExcelLinks)                     'If so get an array of items
        ArrBegin = LBound(ExclLnks)
        ArrEnd = UBound(ExclLnks)
        
        For i = ArrBegin To ArrEnd
            If RmvLnk Then                                          'if you passed true Aka you want
                WB.BreakLink ExclLnks(i), xlLinkTypeExcelLinks
            Else
                Debug.Print ExclLnks(i)
            End If
        Next i
        result = True                                               'links were found in WB
    End If
    
    If Not IsEmpty(WB.LinkSources(xlOLELinks)) Then                 'Checks if there's any linked OLE object
        OLElnks = WB.LinkSources(xlOLELinks)
        ArrBegin = LBound(OLElnks)
        ArrEnd = UBound(OLElnks)
        
        For i = ArrBegin To ArrEnd
            If RmvLnk Then
                WB.BreakLink OLElnks(i), xlLinkTypeOLELinks
            Else
                Debug.Print OLElnks(i)
            End If
        Next i
        result = True                                               'links were found in WB
    End If
    

End Function

Source:

Workbook.LinkSources method (Excel)

Workbook.BreakLink method (Excel)

Answer 3

This post is ugly formatted (and in Spanish), but the code is quite useful. I've used it myself often: It lists all your external links (so you can manually fix them if you wish), and it also offers to you replace the broken ones with the latest known values, so you get rid of the annoying message for good.

https://www.pasalo.es/como-identificar-los-links-rotos-en-tu-excel-usando-una-macro-excel-vba/

(Note: not sure if I can just copy the code here, as it's not mine)