Tim D'Annecy

#VBscript #Excel

A finance department that I'm working with needs a way to archive a ton of Excel files before migration. They're using cross-file links in their formulas (e.g. =xlookup('OtherFile.xlsx',A1)) and were concerned that users would accidentally trigger a refresh after their data was moved into a new SharePoint tenant and change historical records.

They started the manual task of opening each Excel file, selecting all, copying, then pasting values. Lots of Ctrl+A, Ctrl+C, Ctrl+Shift+V, click, Ctrl+S, Ctrl+W.

To make this easier and faster, I created a VBScript that allows you to pick some files and break the links on all of them.

This will create a “hard coded” or static file with no cross-sheet or cross-workbook links. It won't delete in-workbook formulas (e.g. =4+A1) so files that are intended to be used as a template will still calculate. The script also generates a log of all of the files that were updated so that you can have a record of changes, if you need to go back and confirm.

This script is destructive (by removing links) and will save automatically. I would recommend backing up your files before running this script.

Sub Break_Links()
  ' Tim D'Annecy 2023
  ' Script to break links in Excel files.
  ' Run the macro, pick some files, then check the output tab for a log.
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Dim FileNames
    Dim file
    Dim wb As Workbook
    Dim Links As Variant
    Dim i As Integer
    Dim wsLog As Worksheet
    Dim logRow As Long
    
    FileNames = Application.GetOpenFilename(MultiSelect:=True)

    If Not IsArray(FileNames) Then Exit Sub

    ' Add a new worksheet to log updated files
    On Error Resume Next
    Set wsLog = ThisWorkbook.Sheets("UpdatedFiles")
    On Error GoTo 0
    
    If wsLog Is Nothing Then
        Set wsLog = ThisWorkbook.Sheets.Add
        wsLog.Name = "UpdatedFiles"
        wsLog.Cells(1, 1).Value = "Updated Files:"
        logRow = 2
    Else
        logRow = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1
    End If
    
    For Each file In FileNames
        Set wb = Workbooks.Open(file)
        On Error Resume Next
        Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
        On Error GoTo 0
        If Not IsEmpty(Links) Then
            For i = 1 To UBound(Links)
                wb.BreakLink Name:=Links(i), Type:=xlLinkTypeExcelLinks
            Next i
            ' Log the updated file
            wsLog.Cells(logRow, 1).Value = file
            logRow = logRow + 1
        End If
        wb.Save
        wb.Close
    Next
    
    ' Autofit the columns in the log worksheet
    wsLog.Columns.AutoFit
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
End Sub

Script on Gist:

I hope this is helpful to someone! I spent a long time trying to find the right scripts for my use case.

Discuss...