' Code courtesy of UtterAccess Wiki
' http://www.utteraccess.com/wiki/index.php/Category:FunctionLibrary
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' REV  DATE                          DESCRIPTION
' 1.0  2010-08-16              initial release
' 1.1  2010-09-12              modified function header
'
'==============================================================================
' NAME: GetSQLRecordcount
' PURPOSE: returns the recordcount of a non-action query
' RETURNS: Long, number of records in the SQL passed, 0 on error
' ARGUMENTS: strSQL: SQL Statement to evaluate
' USAGE: first word must be "SELECT" (case-insensitive)
'        current handling for CurrentDb only
'
' DEPENDANCIES: DAO/ACEDAO
'
' REVISIONS:
'  REV |    DATE    | REV TYPE | DESCRIPTION
'------------------------------------------------------------------------------
'  R01   8/16/2010    INITIAL
'
'==============================================================================
'ErrHandler V3.01
Public Function GetSQLRecordcount(strSQL As String) As Long
On Error GoTo Error_Proc
Dim Ret As Long
'=========================
 Const ERRN_SQL_NOTSELECT = 8000 + vbObjectError
 Const ERRM_SQL_NOTSELECT As String = _
   "The SQL is not a Select statement."

 Dim rs As DAO.Recordset
'=========================

 'make sure the statement starts with select
 If StrComp(Left(LTrim(strSQL), 6), "SELECT", vbTextCompare) <> 0 Then
   'raise error
   Err.Raise ERRN_SQL_NOTSELECT, , ERRM_SQL_NOTSELECT
 End If

 Set rs = CurrentDb.OpenRecordset(strSQL)
 
 If rs.RecordCount <> 0 Then
   rs.MoveLast
   Ret = rs.RecordCount
 Else
   Ret = 0
 End If
 
 rs.Close
 
'=========================
Exit_Proc:
 Set rs = Nothing
 GetSQLRecordcount = Ret
 Exit Function
Error_Proc:
 Select Case Err.Number
   Case Else
     MsgBox "Error: " & Trim(str(Err.Number)) & vbCrLf & _
       "Desc: " & Err.Description & vbCrLf & vbCrLf & _
       "Module: modSQLUtil, Procedure: GetSQLRecordcount" _
       , vbCritical, "Error!"
 End Select
 Resume Exit_Proc
 Resume
End Function