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

Функции для работы с записями

Администратор

Функция DLookUp работает медленно, опыт и практика показали, что лучше иметь под рукой собственную функцию, работающую аналогично. Системной функции удаления записи вообще не существует. На мастеровскую кнопку MSA вешает вызов пунктов меню.

Возврат значения из таблицы. Возвращает ТОЛЬКО первое значение, даже если в выборке их несколько. Работает аналогично DLookUp, но несколько быстрее, иногда критично быстрее. Проведенный тестинг показывает, что на локальных таблицах данная функция работает сравнимо с DLookup, но все же немного медленнее. На прилинкованных таблицах DLookup уже значительно проигрывает, и чем сложнее условия, тем больше разрыв по производительности (см. http://msa.dimsign.ru/index.php?type=112&idTheme=114).

Public Function GetRec(NameOfField As String, NameOfTable As String, Optional Where As String = "")
Dim r As Recordset
Dim sql As String
Dim result
On Error GoTo 2

sql = "SELECT " & NameOfField & " FROM " & NameOfTable
If Len(Where) > 0 Then sql = sql & " WHERE (" & Where & ")"
Set r = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If r.EOF And r.BOF Then GoTo 1
r.MoveFirst
result = r.Fields(NameOfField)
1:

r.Close
Set r = Nothing
GetRec = result
Exit Function
2:
'MsgBox "Неверный запрос: " & sql & "!"
GetRec = "None" 'Можно и Null
End Function

Удаление записи. Первый аргумент - имя таблицы, второй - условие. Последний аргумент необязательный, при его установке в неноль будет удалена только первая запись. На практике последний аргумент не использовался и носит исключительно теоретическое значение.

Public Function Delrec(Tbl As String, Whr As Long, Optional OneRec As Long = 0) As Boolean
Dim r As Recordset
Dim sql As String
sql = "SELECT * FROM " & Tbl & " WHERE " & Whr
Set r = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
If r.EOF And r.BOF Then Delrec = False: GoTo 1
r.MoveLast
If r.RecordCount > 1 Then
If OneRec = 0 Then
r.MoveFirst
While Not r.EOF
r.delete
r.MoveNext
Wend
Delrec = True
Else
Delrec = False
GoTo 1
End If
Else
r.MoveFirst
r.delete
Delrec = True
End If
1:
r.Close
Set r = Nothing
End Function

Впрочем, ничто не мешает упросить функцию до следующего варианта, но тогда пропадает контроль за количеством удаленных записей:

Public Function Delrec(Tbl As String, Whr As Long) As Boolean
Dim sql As String
sql = "DELETE * FROM " & Tbl & " WHERE " & Whr
CurrentDb.Execute sql
End Function