For years now I've avoided using the native Dcount function like the plague because I've been told it has terrible performance.
Today, I'm starting to plan a new application (rewrite of an existing one), so I've been looking into performance. I have a table that I need to regularly query the record count on. Currently, it's up to about 48,000 records but will grow significantly over the lifetime of this new application.
So, I tested 4 different avenues, with the cls timer function available here: https://modthemachine.typepad.com/my_weblog/2010/06/how-to-time-an-operation.html
options were:
Here were the results:
? RunTests
Using Allen Browne ECount Function: 0.069454;RecCount = 48062
Using DCount NativeFunction: 0.067723;RecCount = 48062
Using DAO.Recordset: 0.223418;RecCount = 48062
Using SQL PassThru Query: 0.064766;RecCount = 48062
The results are in seconds, and 48,062 records were pulled.
I'm surprised to see that Dcount worked pretty well. I've been using DAO.Recordset instead for many things, and it turns out it's significantly slower.
I'm going to post the code in case someone can improve on it or point out an error. I'm also curious if anyone is willing to do a similar test on a larger recordset.
Here is the clsTimer:
And the module for the tests
If one doesn't have it, here's the Ecount function off of Allen Browne's site, found here: http://www.allenbrowne.com/ser-66.html
Today, I'm starting to plan a new application (rewrite of an existing one), so I've been looking into performance. I have a table that I need to regularly query the record count on. Currently, it's up to about 48,000 records but will grow significantly over the lifetime of this new application.
So, I tested 4 different avenues, with the cls timer function available here: https://modthemachine.typepad.com/my_weblog/2010/06/how-to-time-an-operation.html
options were:
- Allen Brownes Ecount Function
- Native Dcount Function
- DAO Recordset
- a saved SQL Pass thru query
Here were the results:
? RunTests
Using Allen Browne ECount Function: 0.069454;RecCount = 48062
Using DCount NativeFunction: 0.067723;RecCount = 48062
Using DAO.Recordset: 0.223418;RecCount = 48062
Using SQL PassThru Query: 0.064766;RecCount = 48062
The results are in seconds, and 48,062 records were pulled.
I'm surprised to see that Dcount worked pretty well. I've been using DAO.Recordset instead for many things, and it turns out it's significantly slower.
I'm going to post the code in case someone can improve on it or point out an error. I'm also curious if anyone is willing to do a similar test on a larger recordset.
Here is the clsTimer:
Code:
'@Folder("VBAProject.Classes")
Option Compare Database
Option Explicit
Private Declare Function QueryPerformanceFrequency _
Lib "kernel32" (lpFrequency As Currency) As Long
Private Declare Function QueryPerformanceCounter _
Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private ConversionFactor As Currency
Private CurrentStartTime As Currency
Public Sub Start()
Dim iReturn As Long
iReturn = QueryPerformanceCounter(CurrentStartTime)
End Sub
Private Sub Class_Initialize()
Dim iReturn As Long
iReturn = QueryPerformanceFrequency(ConversionFactor)
End Sub
Public Property Get CurrentTime() As Double
Dim NewTime As Currency
Dim iReturn As Long
iReturn = QueryPerformanceCounter(NewTime)
Dim TotalTime As Currency
TotalTime = NewTime - CurrentStartTime
CurrentTime = TotalTime / ConversionFactor
End Property
And the module for the tests
Code:
Option Compare Database
Option Explicit
Public Function usingECount() As String
' Status: In Devlopment
' Comments:
' Params :
' Returns : Boolean
' Created : 04/16/19 15:05 GB
' Modified:
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim t As New clsTimer
Dim i As Long
t.Start
i = ECount("[WoNbr]", "DBA_WO")
usingECount = "Using Allen Browne ECount Function: " & Format(t.CurrentTime, "0.000000") & ";" & "RecCount = " & i
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Set t = Nothing
Exit Function
PROC_ERR:
MsgBox Err.Description, vbCritical, "mWoCountOptions.usingECount"
Resume PROC_EXIT
Resume
Resume
'TVCodeTools ErrorHandlerEnd
End Function
Public Function usingDCount() As String
' Status: In Devlopment
' Comments:
' Params :
' Returns : Boolean
' Created : 04/16/19 15:05 GB
' Modified:
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim t As New clsTimer
Dim i As Long
t.Start
i = DCount("[WoNbr]", "DBA_WO")
usingDCount = "Using DCount NativeFunction: " & Format(t.CurrentTime, "0.000000") & ";" & "RecCount = " & i
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Set t = Nothing
Exit Function
PROC_ERR:
MsgBox Err.Description, vbCritical, "mWoCountOptions.usingDCount"
Resume PROC_EXIT
Resume
Resume
'TVCodeTools ErrorHandlerEnd
End Function
Public Function usingRecordset() As String
' Status: In Devlopment
' Comments:
' Params :
' Returns : String
' Created : 04/16/19 15:11 GB
' Modified:
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim t As New clsTimer
Dim i As Long
t.Start
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSql As String
Set dbs = CurrentDb
strSql = "SELECT [WoNbr] " & _
"FROM [DBA_WO]"
Set rst = dbs.OpenRecordset(strSql, dbOpenDynaset, dbSeeChanges)
With rst
.MoveLast
i = .RecordCount
.Close
End With
Set rst = Nothing
dbs.Close
Set dbs = Nothing
usingRecordset = "Using DAO.Recordset: " & Format(t.CurrentTime, "0.000000") & ";" & "RecCount = " & i
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Set t = Nothing
Exit Function
PROC_ERR:
MsgBox Err.Description, vbCritical, "mWoCountOptions.usingRecordset"
Resume PROC_EXIT
Resume
Resume
'TVCodeTools ErrorHandlerEnd
End Function
Public Function usingPassThruQry() As String
' Status: In Devlopment
' Comments:
' Params :
' Returns : String
' Created : 04/16/19 15:18 GB
' Modified:
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Dim t As New clsTimer
Dim i As Long
Dim rst As DAO.Recordset
t.Start
Set rst = CurrentDb.QueryDefs("qryWoCountPassThru").OpenRecordset
'With rst
' .MoveLast
' If .RecordCount = 1 Then
i = rst.Fields("Count()").Value
' End If
'End With
usingPassThruQry = "Using SQL PassThru Query: " & Format(t.CurrentTime, "0.000000") & ";" & "RecCount = " & i
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Set rst = Nothing
Set t = Nothing
Exit Function
PROC_ERR:
MsgBox Err.Description, vbCritical, "mWoCountOptions.usingPassThruQry"
Resume PROC_EXIT
Resume
Resume
'TVCodeTools ErrorHandlerEnd
End Function
Public Function RunTests() As Boolean
' Status: In Devlopment
' Comments:
' Params :
' Returns : Boolean
' Created : 04/16/19 15:21 GB
' Modified:
'TVCodeTools ErrorEnablerStart
On Error GoTo PROC_ERR
'TVCodeTools ErrorEnablerEnd
Debug.Print usingECount
Debug.Print usingDCount
Debug.Print usingRecordset
Debug.Print usingPassThruQry
RunTests = True
'TVCodeTools ErrorHandlerStart
PROC_EXIT:
Exit Function
PROC_ERR:
MsgBox Err.Description, vbCritical, "mWoCountOptions.RunTests"
Resume PROC_EXIT
Resume
Resume
'TVCodeTools ErrorHandlerEnd
End Function
If one doesn't have it, here's the Ecount function off of Allen Browne's site, found here: http://www.allenbrowne.com/ser-66.html
Code:
Public Function ECount(Expr As String, Domain As String, Optional Criteria As String, Optional bCountDistinct As Boolean) As Variant
On Error GoTo Err_Handler
'Purpose: Enhanced DCount() function, with the ability to count distinct.
'Return: Number of records. Null on error.
'Arguments: Expr = name of the field to count. Use square brackets if the name contains a space.
' Domain = name of the table or query.
' Criteria = any restrictions. Can omit.
' bCountDistinct = True to return the number of distinct values in the field. Omit for normal count.
'Notes: Nulls are excluded (whether distinct count or not.)
' Use "*" for Expr if you want to count the nulls too.
' You cannot use "*" if bCountDistinct is True.
'Examples: Number of customers who have a region: ECount("Region", "Customers")
' Number of customers who have no region: ECount("*", "Customers", "Region Is Null")
' Number of distinct regions: ECount("Region", "Customers", ,True)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSql As String
'Initialize to return Null on error.
ECount = Null
Set db = DBEngine(0)(0)
If bCountDistinct Then
'Count distinct values.
If Expr <> "*" Then 'Cannot count distinct with the wildcard.
strSql = "SELECT " & Expr & " FROM " & Domain & " WHERE (" & Expr & " Is Not Null)"
If Criteria <> vbNullString Then
strSql = strSql & " AND (" & Criteria & ")"
End If
strSql = strSql & " GROUP BY " & Expr & ";"
Set rs = db.OpenRecordset(strSql)
If rs.RecordCount > 0& Then
rs.MoveLast
End If
ECount = rs.RecordCount 'Return the number of distinct records.
rs.Close
End If
Else
'Normal count.
strSql = "SELECT Count(" & Expr & ") AS TheCount FROM " & Domain
If Criteria <> vbNullString Then
strSql = strSql & " WHERE " & Criteria
End If
Set rs = db.OpenRecordset(strSql)
If rs.RecordCount > 0& Then
ECount = rs!TheCount 'Return the count.
End If
rs.Close
End If
Exit_Handler:
Set rs = Nothing
Set db = Nothing
Exit Function
Err_Handler:
MsgBox Err.Description, vbExclamation, "ECount Error " & Err.Number
Resume Exit_Handler
End Function
Last edited: