Sub CheckAllLinks()
Dim avLinks As Variant
Dim nLinkIndex As Integer
Dim sMsg As String
Dim wb As Workbook
Set wb = ActiveWorkbook
avLinks = wb.LinkSources(xlExcelLinks)
If IsEmpty(avLinks) Then
Debug.Print wb.name & " does not have any links."
Else
For nLinkIndex = 1 To UBound(avLinks)
Debug.Print "Workbook: " & wb.name
Debug.Print "Link Source: " & avLinks(nLinkIndex)
Debug.Print "Status: " & GetLinkStatus(wb, CStr(avLinks(nLinkIndex)))
Next
End If
End Sub
Function GetLinkStatus(wb As Workbook, sLink As String) As String
Dim avLinks As Variant
Dim nIndex As Integer
Dim sResult As String
Dim nStatus As Integer
avLinks = wb.LinkSources(xlExcelLinks)
If IsEmpty(avLinks) Then
GetLinkStatus = "No links in workbook."
Exit Function
End If
For nIndex = 1 To UBound(avLinks)
If StrComp(avLinks(nIndex), sLink, vbTextCompare) = 0 Then
nStatus = ActiveWorkbook.LinkInfo(sLink, xlLinkInfoStatus)
Select Case nStatus
Case xlLinkStatusCopiedValues
sResult = "Copied values"
Case xlLinkStatusIndeterminate
sResult = "Indeterminate"
Case xlLinkStatusInvalidName
sResult = "Invalid name"
Case xlLinkStatusMissingFile
sResult = "Missing file"
Case xlLinkStatusMissingSheet
sResult = "Missing sheet"
Case xlLinkStatusNotStarted
sResult = "Not started"
Case xlLinkStatusOK
sResult = "OK"
Case xlLinkStatusOld
sResult = "Old"
Case xlLinkStatusSourceNotCalculated
sResult = "Source not calculated"
Case xlLinkStatusSourceNotOpen
sResult = "Source not open"
Case xlLinkStatusSourceOpen
sResult = "Source open"
Case Else
sResult = "Unknown status code"
End Select
Exit For
End If
Next
GetLinkStatus = sResult
End Function
|