VBA/Excel/Access/Word/Excel/Workbook Links
Checking the Status of All the Links in a Workbook
<source lang="vb">
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
</source>
Link Status Checker
<source lang="vb">
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
</source>
Updating Links with a New File Location
<source lang="vb">
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
</source>