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

Материал из VB Эксперт
Перейти к: навигация, поиск

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>