Solved Replace query by vba code, with dcount

[Superpat]

Hello,
I have create a query, name "Requête2" :

SELECT DISTINCT tblVariables.NomBase
FROM tblVariables;

And In my vba code, I write :

Dim lCompte As Long
lCompte = DCount("*", "Requête2")

This code is right, and it give me the number of different NomBase.

Can I do the same with just vba code ?

 

[CJ_London]

Not with select distinct, you would need to open a recordset

something like

dim rs as dao.recordset
dim lCompe as long
set rs=currentdb.openrecordset("SELECT DISTINCT tblVariables.NomBase FROM tblVariables")
rs.movelast
lCompte=rs.recordcount

or

dim rs as dao.recordset
dim lCompe as long
set rs=currentdb.openrecordset("SELECT Count(*) FROM (SELECT DISTINCT tblVariables.NomBase FROM tblVariables)")
lCompte=rs.fields(0)

 

[Superpat]

Thanks @CJ_London it's just what I want

 

[Josef P.]

Tip: Create a helper function that returns a single value like DLookup. Instead of the parameters for the data field, the data source and the filter expression, you pass an SQL string.

Then your code might look like this:

Dim lCompte As Long
lCompte = LookupSql("SELECT Count(*) FROM (SELECT DISTINCT tblVariables.NomBase FROM tblVariables)")

/edit:
Code example with DCount replacement function:
lCompte = DCount(Expr:="NomBase", Domain:="tblVariables", Distinct:=true)

Public Function DCount(ByVal Expr As String, ByVal Domain As String, Optional ByVal Criteria As Variant, _
              Optional ByVal Distinct As Boolean = False) As Variant

   If Distinct Then
      DCount = LookupSql("select Count(" & Expr & ") from (" & BuildSelectSql(Expr, Domain, Criteria, True) & ")")
   Else
      DCount = Application.DCount(Expr, Domain, Criteria)
   End If

End Function

Private Function BuildSelectSql(ByVal Expr As String, ByVal Domain As String, Optional ByVal Criteria As Variant, _
                       Optional ByVal Distinct As Boolean = False)

   Dim SelectSql As String

   SelectSql = "SELECT "
   If Distinct Then
      SelectSql = SelectSql & "Distinct "
   End If
   SelectSql = SelectSql & Expr & " FROM (" & Domain & ")"

   If Not IsMissing(Criteria) Then
      If Len(Criteria) > 0 Then
         SelectSql = SelectSql & " WHERE " & Criteria
      End If
   End If
 
   BuildSelectSql = SelectSql

End Function

Public Function LookupSql(ByVal SqlText As String, _
                 Optional ByVal Index As Variant = 0&, _
                 Optional ByVal ValueIfNull As Variant = Null, _
                 Optional ByVal DatabaseToUse As DAO.Database = Nothing) As Variant

   Dim rst As DAO.Recordset

On Error GoTo HandleErr

   If DatabaseToUse Is Nothing Then
      Set DatabaseToUse = CurrentDb
   End If

   Set rst = DatabaseToUse.OpenRecordset(SqlText, dbOpenForwardOnly, dbSeeChanges, dbReadOnly)
   With rst
      If .EOF Then
         LookupSql = ValueIfNull
      Else
         LookupSql = Nz(.Fields(Index), ValueIfNull)
      End If
      .Close
   End With
   Set rst = Nothing
 
ExitHere:
   Exit Function
 
HandleErr:
   If Not (rst Is Nothing) Then
      rst.Close
      Set rst = Nothing
   End If
 
   Err.Raise Err.Number, "LookupSQL:" & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext

End Function

 

[Superpat]

Tip: Create a helper function that returns a single value like DLookup. Instead of the parameters for the data field, the data source and the filter expression, you pass an SQL string.

Then your code might look like this:

Dim lCompte As Long
lCompte = LookupSql("SELECT Count(*) FROM (SELECT DISTINCT tblVariables.NomBase FROM tblVariables)")

/edit:

Thanks @Josef P. for your two examples, before you edit your message, I don't understand it.
Now, I tried them and they work perfectly.

 

[Gasman]

@Josef P.
Is it wise to create a UDF with the same name as an Access function?

 

[Josef P.]

@Gasman: if you want to replace them with it globally

Of course, you could use a new name for it. But then you also have to remember it.
Think about DCount a bit further and imagine that you replace DCount with a faster variant.
Why should you then rewrite the name everywhere in the code?

For example, I regularly replace the MsgBox function to be able to use localization inside the MsgBox (see L10nTools).
When I overwrite something, however, I always pay attention to the same parameter interface, which I extend by a few optional parameters at most.

I would not overwrite everything and always and make it the rule . In special cases it can be useful.

Argument for DCount:

• The new function has the same parameters as Application.DCount + 1 additional parameter.
• The function returns the same result for the same parameter values

=> If it looks like a duck, then it is a duck.

But: you could of course also write a function that has Distinct directly in its name. That would also be a good readable variant for me.

lCompte  = DistinctDCount("NomBase", "tblVariables")

with:

Public Function DistinctDCount(ByVal Expr As String, ByVal Domain As String, Optional ByVal Criteria As Variant) As Variant
      DistinctDCount = LookupSql("select Count(" & Expr & ") from (" & BuildSelectSql(Expr, Domain, Criteria, True) & ")")
End Function

 

[Pat Hartman]

As long as no one but you will EVER have to modify the app, do whatever you want. Unless you are immortal and have tenure, I think it is a bad idea. -- just my opinion.