Удаление битых ссылок на библиотеки методом References.Remove

Источник: Rusimport
Кривцов Анатолий

Access перед удалением ссылки ищет в реестре ключ с её GUID и версией.
Решение состоит в том, что если первая попытка удаления не удалась, то создается ветка в реестре (GUID и версию можно вычитать из битой ссылки). Затем удаляется ссылка, потом ветка, а затем создается ссылка на самую свежую версию библиотеки (если есть).
Данный пример вполне работоспособен, так как проверялся на библиотеках Excel и Word.

Function CheckBrokenReferences() As Boolean
On Error Resume Next
Dim refs As Access.References, ref As Access.Reference, i As Integer, fBroken As Boolean
Dim wshShell As Object, strGUID As String, strKey As String

Set refs = Application.References
'Проход по ссылкам в обратном порядке
For i = refs.Count To 0 Step -1
Set ref = refs(i)
If Not ref.IsBroken Then GoTo NextReference
If ref.BuiltIn Then fBroken = True: Exit For
'Первая попытка удаления битой ссылки
refs.Remove ref
If Err.Number = 0 Then GoTo NextReference
Err.Clear
If ref.Kind = 1 Then fBroken = True: GoTo NextReference
'Если возникла ошибка при удалении ссылки на библиотеку, методами WSH пытается
'добавить в реестр ветку с GUID и версией из битой ссылки, удалить ссылку,
'а затем удалить ветку.
If wshShell Is Nothing Then Set wshShell = CreateObject("WScript.Shell")
If Err.Number <> 0 Then fBroken = True: GoTo NextReference
strGUID = ref.Guid
strKey = "HKCR\TypeLib\" & strGUID & "\" & ref.Major & "." & ref.Minor & "\"
wshShell.RegWrite strKey & "0\win32\", ""
'Вторая попытка удаления ссылки (она, типа, зарегистрирована)
refs.Remove ref
If Err.Number <> 0 Then Err.Clear: fBroken = True

wshShell.RegDelete strKey & "0\win32\"
wshShell.RegDelete strKey & "0\"
wshShell.RegDelete strKey

'Пытается создать ссылку на самую свежую зарегистрированную библиотеку.
refs.AddFromGuid strGUID, 0, 0

NextReference:
Next i
' Next ref

CheckBrokenReferences = fBroken

CheckBrokenReferences_exit:
Set ref = Nothing
Set refs = Nothing
Set wshShell = Nothing
Exit Function
End Function


Страница сайта http://185.71.96.61
Оригинал находится по адресу http://185.71.96.61/home.asp?artId=7228