Get all linked files to an Excel 2003 document

Question

I want to get a list of all the linked files in an Excel 2003 document, or, better still, automatically retrieve all the files linked to the document and zip them. Is such an operation possible? I am finding gathering the files manually very tedious.

Answer 1

An easier way to do it is to use the .LinkSources method.

For example, the below code will print a list of all links to Excel files.

Sub PrintLinks()
   Dim v() As Variant, i As Integer
   v = ThisWorkbook.LinkSources(XlLink.xlExcelLinks)
   For i = 1 To UBound(v)
      Debug.Print v(i)
   Next i
End Sub

Answer 2

Here's a start. This macro will return a list of all linked workbooks by looking for file names in all the formulas in the workbook. One quirk to note is that it will only return the file path of the workbook if that workbook is not currently open. I haven't taken the time to figure out a way around that, but the good news is that you should know the file path anyway if the workbook is already open.

Sub getlinks()

Dim ws As Worksheet
Dim tmpR As Range, cellR As Range
Dim links() As String
Dim i As Integer, j As Integer

j = 0
'Look through all formulas for workbook references. Store all refs in an array.
For Each ws In ThisWorkbook.Worksheets
    Set tmpR = ws.UsedRange
    For Each cellR In tmpR.Cells
        i = InStr(cellR.Formula, "'")
        If i <> 0 Then
            ReDim Preserve links(0 To j) As String
            links(j) = Mid(cellR.Formula, i, InStr(i + 1, cellR.Formula, "'") - i)
            j = j + 1
            Do While i <> 0
                On Error GoTo ErrHand
                i = InStr(i + 1, cellR.Formula, "'")
                i = InStr(i + 1, cellR.Formula, "'")
                If i <> 0 Then
                    ReDim Preserve links(0 To j) As String
                    links(j) = Mid(cellR.Formula, i, InStr(i + 1, cellR.Formula, "'") - i)
                    j = j + 1
                End If
            Loop
        End If
    Next cellR
Next ws

'Add new worksheet to post list of links.
Set ws = Sheets.Add
ws.Name = "List of Linked Workbooks"

Set tmpR = ws.Range("A1").Resize(UBound(links) + 1, 1)
tmpR = Application.WorksheetFunction.Transpose(links)

'Clean up output.
For Each cellR In tmpR
    cellR = Left(cellR.Value, InStr(cellR.Value, "]") - 1)
    cellR = Replace(cellR.Value, "[", "")
Next cellR
'Code to remove duplicates from list.  .RemoveDuplicates property only works for Excel 2007 and later. Line is commented out below.
'tmpR.RemoveDuplicates Columns:=1, Header:=xlNo
Exit Sub

ErrHand:
i = 0
Resume Next

End Sub