Function JS_ReferencesRestore()
Dim MyReference As Reference
'Массив на 4 ссылки
Dim RefGUID(1, 5) As String
Dim i As Integer
'Набивка массива
'DAO 3.6
RefGUID(0, 0) = "{00025E01-0000-0000-C000-000000000046}"
RefGUID(0, 1) = "DAO"
RefGUID(0, 2) = 5
RefGUID(0, 3) = 0
RefGUID(0, 4) = "DAO360.DLL"
RefGUID(0, 5) = "Microsoft DAO 3.6 Object Library"
'OLE Automation
RefGUID(1, 0) = "{00020430-0000-0000-C000-000000000046}"
RefGUID(1, 1) = "stdole"
RefGUID(1, 2) = 2
RefGUID(1, 3) = 0
RefGUID(1, 4) = "STDOLE2.TLB"
RefGUID(1, 5) = "OLE Automation"
For i = 0 To 1
On Error Resume Next
Set MyReference = References(RefGUID(i, 1))
'Если ссылка не установлена - пытаемся восстановить из реестра
If Err > 0 Then
Err.Clear
Set MyReference = References.AddFromGuid(RefGUID(i, 0), RefGUID(i, 2), RefGUID(i, 3))
'Если ссылка не прописана в реестре
If Err > 0 Then
GoTo For_Err
End If
End If
'Если версии требуемой и установленной совпадают с уже установленной ссылкой
If MyReference.guid = GUIDFromString(RefGUID(i, 0)) Then
'MsgBox RefGUID(i, 4) & " - " & RefGUID(i, 4) & " у порядке!"
GoTo ForBye
Else 'Если версии требуемой и установленной НЕ совпадают
References.Remove MyReference 'Удаляем установленную
'Пытаемся подключить требуюмую
Set MyReference = References.AddFromGuid(RefGUID(i, 0), RefGUID(i, 2), RefGUID(i, 3))
If Err > 0 Then
GoTo For_Err
End If
End If
'Проверяем "Не отвалилась ли???"
If MyReference.IsBroken = True Then
MsgBox "Reference to: " & RefGUID(i, 5) & " is broken"
End If
GoTo ForBye
For_Err:
MsgBox "Can't find file: " & RefGUID(i, 4) & " for reference: " & RefGUID(i, 5)
ForBye:
Next i
Set MyReference = Nothing
End Function
|