VBA/Excel/Access/Word/Excel/Workbook Links

Checking the Status of All the Links in a Workbook

 
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

Link Status Checker

 
Function GetLinkStatus(sLink As String) As String 
    Dim avLinks As Variant 
    Dim nIndex As Integer 
    Dim sResult As String 
    Dim nStatus As Integer 
    avLinks = ActiveWorkbook.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

Updating Links with a New File Location

 
Sub FixLinks(wb As Workbook, sOldLink As String, sNewLink As String) 
    Dim avLinks As Variant 
    Dim nIndex As Integer 
    avLinks = wb.LinkSources(xlExcelLinks) 
    If Not IsEmpty(avLinks) Then 
        For nIndex = 1 To UBound(avLinks) 
            If _ 
            StrComp(avLinks(nIndex), sOldLink, vbTextCompare) = 0 Then 
                wb.ChangeLink sOldLink, sNewLink, xlLinkTypeExcelLinks 
                Exit For 
            End If 
        Next 
    End If 
End Sub