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

Источник: msadimsign

Функция 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

Ссылки по теме