Summary / List of Linked Source Files?


Board Regular
Jul 5, 2005
I'm working with a massive web of spreadsheets and trying to trace what is coming from where. I see references to at least 15-20 different files. The person who maintains this file is away for at least a week and I'd like to get a better handle on how things are linked.

I'll be working on a database to replace this big web, so I want to know what all I'll need to import/export as far as data goes.

Is there a procedure that could give me a list of linked files, file location, etc?

Ideally, I could get some sort of table that included a cell and which cells it references or something like that, but just a quick summary would be something. I can go to Edit-->Links but would like a quick way to copy this information out.

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Hi WestJelly

You can copy and paste the following code into a new workbook, set a reference to Microsoft Scripting Runtime library within the VBE (Tools>References) and then run the macro from within Excel (Tools>Macro>Macros) and navigate to the folder that you want to list external links of the workbooks in said folder. Give it a try. Note this effectively only inserts a list (as available from Edit>Links) but it does do it for all workbooks in a folder location. The actual cells with these links are not identified.

Option Explicit 
    hOwner As Long 
    pidlRoot As Long 
    pszDisplayName As String 
    lpszTitle As String 
    ulFlags As Long 
    lpfn As Long 
    lParam As Long 
    iImage As Long 
End Type 
Declare Function SHGetPathFromIDList Lib "shell32.dll" _ 
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _ 
As Long 
Declare Function SHBrowseForFolder Lib "shell32.dll" _ 
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 
Sub ListLinks() 
     'Go Tools>References and set a reference to Microsoft Scripting Runtime
    Dim strDirectory As String, msg As String, bSubFolders As Boolean, arrTemp, k As Integer 
    Dim strFileList() As String, fs As FileSearch, i As Integer, j As Long, iErrorResponse As Integer 
    Dim wb As Workbook, wsLinks As Worksheet, wbLinks As Workbook, wsErrors As Worksheet 
    Dim m As Integer, iSubs As Integer 
    Application.Calculation = xlCalculationManual 
    Application.DisplayAlerts = False 
    Application.ScreenUpdating = False 
    Set wbLinks = ThisWorkbook 
    If SheetExists("Links") Then 
        Set wsLinks = wbLinks.Sheets("Links") 
        Set wsLinks = wbLinks.Worksheets.Add 
        wsLinks.Name = "links" 
    End If 
    With wsLinks 
        .Rows(1).Font.Bold = True 
        .Cells(1, 1) = "Path" 
        .Cells(1, 2) = "FileName" 
        .Cells(1, 3) = "External Links" 
        .Cells(1, 4) = "Link Detail" 
    End With 
    If SheetExists("Errors") Then 
        Set wsErrors = wbLinks.Sheets("Errors") 
        Set wsErrors = wbLinks.Worksheets.Add 
        wsErrors.Name = "Errors" 
    End If 
    With wsErrors 
        .Rows(1).Font.Bold = True 
        .Cells(1, 1) = "FullName" 
        .Cells(1, 2) = "Error" 
    End With 
    msg = "Please select a folder." 
    bSubFolders = False 
    Set fs = Application.FileSearch 
    strDirectory = GetDirectory(msg) 
    iSubs = MsgBox("Include workbooks in sub-folders?", vbYesNo, "Sub-Folders") 
    If iSubs = vbYes Then bSubFolders = True 
    With fs 
        .LookIn = strDirectory 
        .SearchSubFolders = bSubFolders 
        .FileType = msoFileTypeExcelWorkbooks 
        If .Execute > 0 Then 
            ReDim strFileList(.FoundFiles.Count - 1) 
            For i = 0 To .FoundFiles.Count - 1 
                strFileList(i) = .FoundFiles(i + 1) 
            Next i 
        Else: MsgBox "No Excel Workbooks found": Exit Sub 
        End If 
    End With 
    j = 2 
    m = 2 
    For i = 0 To UBound(strFileList) 
        On Error Resume Next 
        Set wb = Workbooks.Open(strFileList(i), False, True, , "", , , , , , False) 'Remove the double quotes here if you want Excel to ask you for a password if the file is protected
        If Err > 0 Then Goto Err_Handler 
        On Error Goto 0 
        arrTemp = wb.LinkSources(xlExcelLinks) 
        With wsLinks 
            If IsEmpty(arrTemp) Then 
                .Cells(j, 1) = Left(strFileList(i), InStrRev(strFileList(i), "\")) 
                .Cells(j, 2) = Right(strFileList(i), Len(strFileList(i)) - InStrRev(strFileList(i), "\")) 
                .Cells(j, 3) = False 
                .Cells(j, 4) = "N/A" 
                j = j + 1 
                For k = 1 To UBound(arrTemp) Step 1 '1-based array
                    .Cells(j + k - 1, 1) = Left(strFileList(i), InStrRev(strFileList(i), "\")) 
                    .Cells(j + k - 1, 2) = Right(strFileList(i), Len(strFileList(i)) - InStrRev(strFileList(i), "\")) 
                    .Cells(j + k - 1, 3) = True 
                    .Cells(j + k - 1, 4) = arrTemp(k) 
                Next k 
                j = j + UBound(arrTemp) 
            End If 
        End With 
        Set arrTemp = Nothing 
    Next i 
    If wsErrors.Range("a2") <> "" Then 
        iErrorResponse = MsgBox("View Exceptions Report?", vbYesNo, "Errors encountered") 
        If iErrorResponse = vbYes Then wsErrors.Activate: Exit Sub 
    End If 
    Exit Sub 
    With wsErrors 
        .Cells(m, 1) = strFileList(i) 
        .Cells(m, 2) = "Error Number: " & Err.Number & " Error Description: " & Err.Description 
    End With 
    m = m + 1 
    Goto next_wb 
End Sub 
Function GetDirectory(Optional msg) As String 
    Dim bInfo As BROWSEINFO 
    Dim path As String 
    Dim r As Long, x As Long, pos As Integer 
    bInfo.pidlRoot = 0& 
    If IsMissing(msg) Then 
        bInfo.lpszTitle = "Select a folder." 
        bInfo.lpszTitle = msg 
    End If 
    bInfo.ulFlags = &H1 
    x = SHBrowseForFolder(bInfo) 
    path = Space$(512) 
    r = SHGetPathFromIDList(ByVal x, ByVal path) 
    If r Then 
        pos = InStr(path, Chr$(0)) 
        GetDirectory = Left(path, pos - 1) 
        GetDirectory = "" 
    End If 
End Function 
Function SheetExists(SheetName As String) As Boolean 
    Dim ws As Worksheet 
    SheetExists = False 
    On Error Resume Next 
    Set ws = ThisWorkbook.Sheets(SheetName) 
    If Err = 0 Then SheetExists = True 
End Function

Best regards

Upvote 0

Thanks for the link. It appears (unless I'm overlooking something), that the JWalk Add-In deals with the named ranges. I used it on my master file and it didn't show any links.


Thanks. I threw the code into a module and fired it up. It gave me a list of 380 links in a sheet that showed the file, a true/false for the existence of external links, and then a separate line for each file linked. Whew!
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back