bir denermisiniz ?
Bu kodu modüle olarak kayıt edin sonra Dcount
yerine kodunuzda ECoun kullanın
Kod:
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