'---------------------------------------------------------------------------------------
' Procedure : tSum быстрый DSUM
' DateTime : 23.06.2011 14:19
'---------------------------------------------------------------------------------------
'
Public Function tSum(pstrField As String, pstrTable As String, Optional pstrCriteria As String = "") As Double
On Error GoTo tSum_Err
' Function tSum
' Purpose: Replace DSum, which is slow on attached tables
Dim dbCurrent As Database
Dim rstLookup As Recordset
Dim dblValue As Double, strsql As String
Set dbCurrent = DBEngine(0)(0)
If pstrCriteria = "" Then
strsql = "Select Sum(" & pstrField & ") From " & pstrTable & ";"
Else
strsql = "Select Sum(" & pstrField & ") From " & pstrTable & " Where " & pstrCriteria & ";"
End If
Set rstLookup = dbCurrent.OpenRecordset(strsql, dbOpenForwardOnly)
If Not rstLookup.BOF Then
dblValue = rstLookup(0)
Else
dblValue = 0
End If
rstLookup.Close
tSum = dblValue
tSum_Exit:
On Error Resume Next
rstLookup.Close
Exit Function
tSum_Err:
' Retry/Abort/Ignore
'MsgBox "Error", , "tSum Error " & Err & ";" & Err.Description
End Function
|