Try this. It assumes that you are in the directory that contains the files you want to check.
Sub aaa()
Dim OutSH As Worksheet
Set OutSH = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
filess = Dir("*.xls")
If filess <> "" Then
Do
If filess <> ThisWorkbook.Name Then
Workbooks.Open Filename:=filess, UpdateLinks:=False
alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(alinks) Then
For i = LBound(alinks) To UBound(alinks)
outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
OutSH.Cells(outrow, 1).Value = ActiveWorkbook.Name
OutSH.Cells(outrow, 2).Value = alinks(i)
Next i
End If
ActiveWorkbook.Close savechanges:=False
End If
filess = Dir()
Loop Until filess = ""
End If
Application.ScreenUpdating = True
End Sub
Bookmarks