ExcelBanter - Find Linked Cells

This might give you some ideas:
As posted, it write a list of files to a sheet named Sheet5.
modify Call_Luke to reflect where you want to look.

Then execute Call_Luke.

it recurses through subdirectories of the directory specified (if there are
any subdirectories) writing all files checked. It only looks at xls files
and if a file has a link, it writes it/them out as well.

Dim lgcurrRow As Long

Sub Call_Luke()
Worksheets("Sheet5").UsedRange.ClearContents
lgcurrRow = 1
Cells(lgcurrRow, 1) = "c:\Data1\"
luke_Linkwalker szPath:="c:\data1\", lzCol:=1
End Sub

Public Sub luke_Linkwalker(szPath As String, _
lzCol As Long)
Dim saDirList() As String
Dim saFileList() As String
Dim szNewPath As String
Dim lzNewCol As Long
Dim alink As Variant
Dim blink As Variant
Dim wkbk As Workbook
Dim recSheet As String

recSheet = "Sheet5"

ReDim saDirList(1 To 1)
ReDim saFileList(1 To 1)
saDirList(1) = ""
saFileList(1) = ""
szFname = Dir(szPath, vbDirectory)
' Retrieve the first entry.
i = 0
j = 0
Do While szFname < "" ' Start the loop.
' Ignore the current directory and
'the encompassing directory.
If szFname < "." And szFname < ".." Then
' Use bitwise comparison to make sure
' szFname is a directory.

If (GetAttr(szPath & szFname) And vbDirectory) = _
vbDirectory Then
' get entry only if it is directory
i = i + 1
ReDim Preserve saDirList(1 To i)
saDirList(i) = szFname
Else ' ^Directories
j = j + 1
ReDim Preserve saFileList(1 To j)
saFileList(j) = szFname
End If
End If
szFname = Dir ' Get next entry.
Loop

'Debug.Print szPath & " " & _
' LBound(saFileList) & " " & UBound(saFileList) & " " & _
' LBound(saDirList) & " " & UBound(saDirList)
If Len(saFileList(1)) 0 Then
m = 0
For i = LBound(saFileList) To UBound(saFileList)
If UCase(Right(saFileList(i), 3)) = "XLS" Then
m = m + 1
' If m 35 Then
' Exit Sub
' End If
lgcurrRow = lgcurrRow + 1
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, lzCol + 1) = _
saFileList(i)
' Now Open and look for links
On Error Resume Next
' Debug.Print m & ". " & saFileList(i)
If saFileList(i) < ThisWorkbook.Name Then
Application.EnableEvents = False
Set wkbk = Workbooks.Open _
(FileName:=szPath & saFileList(i), _
updateLinks:=0)
Application.EnableEvents = True
If Err = 0 Then
On Error GoTo 0
aLinks = wkbk.LinkSources(xlOLELinks)
If Not IsEmpty(aLinks) Then
For l = 1 To UBound(aLinks)
lgcurrRow = lgcurrRow + 1
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, lzCol + 2).Value = aLinks(l)
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, 1).Value = "Link: OLE"
Next l
End If
bLinks = wkbk.LinkSources(xlExcelLinks)
If Not IsEmpty(bLinks) Then
For l = 1 To UBound(bLinks)
lgcurrRow = lgcurrRow + 1
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, lzCol + 2).Value = bLinks(l)
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, 1).Value = "Link: Excel"
Next l
End If
Application.DisplayAlerts = False
wkbk.Close
Application.DisplayAlerts = True
Else
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, 1).Value = "Err:" & Err
For Each wrkb1 In Workbooks
If wrkb1.Name = saFileList(i) Then
wkbk.Close
Exit For
End If
Next wrkb1
On Error GoTo 0
End If
Else
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, 1).Value = "Open"
End If
End If
Err = 0
Err.Clear
Next i
End If
If Len(saDirList(1)) 0 Then
For i = LBound(saDirList) To UBound(saDirList)
lgcurrRow = lgcurrRow + 1
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, lzCol + 1) = saDirList(i)
ThisWorkbook.Worksheets(recSheet). _
Cells(lgcurrRow, 1) = "D"
szNewPath = szPath & saDirList(i) & "\"
lzNewCol = lzCol + 1
luke_Linkwalker szPath:=szNewPath, lzCol:=lzNewCol
Next i
End If
End Sub

--
Regards,
Tom Ogilvy

"Debbie Hatten" wrote in message
...
Anyone know of a way to scan all Excel files in a drive to
find out if they have external links?

The issue is that our drive mappings are about to change
so a cell that contains a link to T:\workbook.xls should
now be pointing to G:\workbook.xls. I would like to be
able to scan all network drives for any Excel files that
contain linked cells so that I do not have to open each
one individually and go through Edit-Links to find them.
Is this possible or am I dreaming?

Thanks!