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.
-
do you mean you want to check all the hyperlinks of your Excel file and zip all the pointed files into a package? you could probably do this with VBA or at least with some VBS help if needed– JMaxFeb 16, 2012 at 12:48
-
1No I mean linked files, as in worksheets in other workbooks used as update sources.– deed02392Feb 16, 2012 at 13:28
2 Answers
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
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
-
Pretty awesome, a bug though - it grabs any cell which has apostraphes in, such as text like "got fred's coat as ted's cold" yields
s coat as ted
as a link. I tried to fix it by doing initial InStr on='
instead but it came up with a lot of errors. Also, I wonder if you can make the array unique before dumping? My workbook gives 10,000 rows with this macro and most are the same. I know I can do the unique list thing but handy if you know a VBScript solution. :) Feb 17, 2012 at 9:42 -
Ah, I was hoping the apostrophe wouldn't be an issue. I had built in a line for removing duplicates, but I commented it out when I realized you were using Excel 2003, since it does not support the
.RemoveDuplicates
Range property (or so I've read. If you want to try it out, just remove the apostrophe from the beginning of the line beforeExit Sub
). If that doesn't work, there are several vba solutions available online for removing duplicates that you could incorporate into the macro.– ExcellllFeb 17, 2012 at 17:38 -
Thanks Excellll, any workaround for the apostraphe issue? Regardless, I'm sure someone will find this question on Google some use, so don't despair your time was not spent in vain. Feb 17, 2012 at 19:37
-
I don't have time to work on it now, but I'm sure a regex solution can be implemented to find the start of each workbook reference -- something along the lines of
'[A-Z\[]
.– ExcellllFeb 17, 2012 at 21:14