Получение параметров всех установленных ссылок и сохранение их в таблице

Источник: codingclub

Данная процедура сохраняет параметры всех установленных библиотечных ссылок в специальной табличке - "tblReferences" - которую сама же и создает. В дальнейшем эту таблицу можно использовать как справочную при восстановлении ссылок.

Private Sub SaveReferensesToTable()
′es 17.01.04
′Процедура сохранения библиотечных ссылок в таблицу
′========================================================
Dim tdf As TableDef
Dim fld As Field
Dim idx As Index
Dim ref As Reference
Dim strSQL As String

′Создаем таблицу с попыткой ее предварительного удаления
On Error Resume Next
CurrentDb.TableDefs.Delete "tblReferences"
Err.Clear

On Error GoTo SaveReferensesToTableErr
′Создание таблицы
Set tdf = CurrentDb.CreateTableDef("tblReferences")
tdf.Fields.Append tdf.CreateField("refName", dbText, 40)
tdf.Fields.Append tdf.CreateField("refMajor", dbLong)
tdf.Fields.Append tdf.CreateField("refMinor", dbLong)
tdf.Fields.Append tdf.CreateField("refGUID", dbText, 50)
tdf.Fields.Append tdf.CreateField("refBuildIn", dbBoolean)
tdf.Fields.Append tdf.CreateField("refPath", dbText, 250)

Set idx = tdf.CreateIndex("Primary Key")
With idx
.Fields.Append .CreateField("refName")
.Unique = True
.Primary = True
End With
tdf.Indexes.Append idx
CurrentDb.TableDefs.Append tdf

′Добавляем записи по каждой ссылке
For Each ref In References
strSQL = "INSERT INTO tblReferences " & _
"(refName, refPath, refMajor, refMinor, refGUID, refBuildIn)" & _
" VALUES (′" & ref.Name & "′, ′" & ref.FullPath & "′, ′" & _
ref.Major & "′, ′" & ref.Minor & "′, ′" & ref.Guid & "′, " & ref.BuiltIn & ")"
CurrentDb.Execute strSQL
Next ref
Exit Sub

SaveReferensesToTableErr:
MsgBox "Процедура [SaveReferensesToTable] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
End Sub
 


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