Работает только в MDB. В MDE файлах проверить - то проверит - а восстановить не сможет. Выход есть но это уже другая история....
Public Sub RestoreReferenses()
′es 17.01.04
′Воостановление критичных ссылок при запуске приложения
′только зарегистрированных в реестре - глубже не копаем
′но если что - то можно восстанавливать еще по файлу:
′ Set ref = References.AddFromFile(filepath)
′================================================
Dim ref As Reference
Dim i As Integer, x As Integer
Dim RefGUID() As Variant
On Error GoTo RestoreReferensesErr
′Задаем количество ссылок - ОБЯЗАТЕЛЬНО!
x = 2
′Задаем размерность массива согласно x
ReDim RefGUID(1 To x, 0 To 5) As Variant
′Набивка массива
′1 Ссылка на DAO
RefGUID(1, 0) = "{00025E01-0000-0000-C000-000000000046}" ′GUID
RefGUID(1, 1) = "DAO" ′Имя (не обязательно)
RefGUID(1, 2) = 5 ′Версия - Major
RefGUID(1, 3) = 0 ′Версия - Minor
RefGUID(1, 4) = "dao360.dll" ′Имя файла или полный путь (не обязательно)
RefGUID(1, 5) = "Microsoft DAO 3.6 Object Library" ′Полное название (не обязательно)
′2 OLE Automation
RefGUID(2, 0) = "{00020430-0000-0000-C000-000000000046}"
RefGUID(2, 1) = "stdole"
RefGUID(2, 2) = 2
RefGUID(2, 3) = 0
RefGUID(2, 4) = "STDOLE2.TLB"
RefGUID(2, 5) = "OLE Automation"
On Error Resume Next
For i = 1 To x
Set ref = References(RefGUID(i, 1))
If Err > 0 Then ′Если ссылка не установлена - пытаемся восстановить из реестра
Err.Clear
Set ref = References.AddFromGuid(RefGUID(i, 0), RefGUID(i, 2), RefGUID(i, 3))
′Если ссылка не прописана в реестре то на метку ошибки
If Err > 0 Then GoTo RestoreReferensesErr
End If
′Проверяем не "отвалилась" ли?
If ref.IsBroken = True Then
MsgBox "Библиотечная ссылка: " & RefGUID(i, 5) & " отвалилась !" & vbCrLf & _
"Файл:" & vbCrLf & _
RefGUID(i, 4), vbCritical
End If
Next i
RestoreReferensesBye:
Set ref = Nothing
Exit Sub
RestoreReferensesErr:
MsgBox "Процедура [RestoreReferenses] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
Resume RestoreReferensesBye
End Sub