Cannot Break Link in Excel - VBA - excel

Question

I am coping one worksheet from all the workbooks in a folder and pasting it to a new workbook called workbook2. Issue I am facing is, the VBA code I am using is not performing Data->Edit Links->Break Link action.
Because of this, workbook2 throws the warning, "This workbook contains links to one or more external sources that could be unsafe." every time the workbook2 is opened.
After copy pasting all the worksheets, the code I am using to break link before saving and closing the workbook2 is,
On Error Resume Next
ExternalLinks = workbook2 .LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(ExternalLinks) Then
For breaklink = LBound(ExternalLinks) To UBound(ExternalLinks)
wb1.breaklink Name:=ExternalLinks(breaklink), Type:=xlLinkTypeExcelLinks
Next breaklink
End If
On Error GoTo 0

Answer 1

Try using the next adapted code. It should send a message when a specific link cannot be removed:
Sub testBreakLinks()
Dim ExternalLinks, brLink As Long, WB1 As Workbook
Set WB1 = ThisWorkbook 'use here your workbook to be processed
ExternalLinks = WB1.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsArray(ExternalLinks) Then
For brLink = LBound(ExternalLinks) To UBound(ExternalLinks)
On Error Resume Next
WB1.BreakLink name:=ExternalLinks(brLink), Type:=xlLinkTypeExcelLinks
If err.Number <> 0 Then
MsgBox err.Description & " - " & ExternalLinks(brLink)
err.Clear: On Error GoTo 0
End If
Next brLink
End If
On Error GoTo 0
End Sub
It will work, except the cases of protected sheets where the external links cannot be broken and an error is not raised, neither...
Edited:
I created a procedure and a function able to return addresses of all cells containing such links and a list of protected sheets, where the external links cannot be found/broken:
Sub testFindLinkCellAddresses()
Dim arrLnk, ExternalLinks, lnk As Variant, wb As Workbook
Set wb = ThisWorkbook
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
For Each lnk In ExternalLinks
arrLnk = ExtLinkCells(CStr(lnk), wb)
If arrLnk(0)(0) <> "" Then
Debug.Print "External links for " & lnk & " exist in cells:" & vbCrLf & Join(arrLnk(0), "|")
Debug.Print "____________________________"
Else
Debug.Print "No external links found for " & lnk & vbCrLf & _
IIf(arrLnk(1)(0) <> "", "But the next sheets are protected:" & vbCrLf & _
Join(arrLnk(1), ", ") & ", " & vbCrLf & " and links cannot be found/broken even if they exist there!", "")
Debug.Print "____________________________"
End If
Next
End Sub
Function ExtLinkCells(strLnk As String, wb As Workbook) As Variant
Dim sh As Worksheet, rngForm As Range, strName As String
Dim arr, arrPr, k As Long, p As Long, cel As Range
strName = Right(strLnk, Len(strLnk) - InStrRev(strLnk, "\"))
strName = "[" & strName & "]"
ReDim arr(1000)
ReDim arrPr(wb.Sheets.count)
For Each sh In wb.Sheets
If sh.ProtectContents Then arrPr(p) = sh.name: p = p + 1
On Error Resume Next
Set rngForm = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rngForm Is Nothing Then
For Each cel In rngForm.cells
If InStr(cel.Formula, strName) > 0 Then
arr(k) = Split(cel.Address(external:=True), "]")(1): k = k + 1
End If
Next
End If
Next
If k > 0 Then ReDim Preserve arr(k - 1) Else ReDim arr(0)
If p > 0 Then ReDim Preserve arrPr(p - 1) Else ReDim arrPr(0)
ExtLinkCells = Array(arr, arrPr)
End Function
The code can be improved, of course. For instance, the array keeping the protected sheets array should be declared as Private on top of the module and skip their processing part if the array is not empty. Showing the array content only once, at the end, if the case... But I do not need such a code. I just tried putting myself in the OP's skin and finding a way to better clarify the issue. Knowing the password, the protected sheets can be previously unprotected and protected again at the end (in code, of course) in the sequence trying to break them...