The following will create a query that returns a
specified group of records from a sorted (either alpha or numeric)
query. Try pasting to a new module, then call it as described.
Bob
specified group of records from a sorted (either alpha or numeric)
query. Try pasting to a new module, then call it as described.
Code:
Public Sub SelMid2(ptblName As String, pItem As String, _
pNum As Integer, pOffset As Integer, _
pUpDown As Boolean, Optional qname As String)
'*************************************************************
' PURPOSE: Creates query to retrieve a specified segment
' (e.g. records 6 - 15) from a sorted query.
' CODED BY: raskew
' PARAMETERS:
' ptblName - Name of table/query as string
' pItem - The field to sort on
' pNum - Number of records to return
' pOffset - Starting point minus 1
' pUpDown - Sort order. True = ascending, False = descending
' qName - Optional name of query to be created. If missing,
' Default = qryXOXOX
' EXAMPLE (test from debug window):
' To return records 6-15 from Query3, sorted on FullName, into query
nTest2
' call selmid2("query3", "fullname", 10, 5, True, "nTest2")
Dim db As Database
Dim rs As Recordset
Dim qd As QueryDef
Dim strSQL As String
Dim test As String
Dim tName As String
Dim varHold As Variant
Set db = CurrentDb
'get upper parameter
strSQL = "SELECT TOP " & pOffset & " " & pItem & " FROM " & ptblName & "
ORDER BY " & pItem & IIf(pUpDown, "", " Desc")
'Debug.Print strSQL
Set rs = db.OpenRecordset(strSQL)
rs.MoveLast
varHold = rs(pItem)
'Debug.Print varHold
rs.Close
'create SELECT TOP query, predicated on varHold
strSQL = "SELECT TOP " & pNum & " " & pItem & " FROM " & ptblName
strSQL = strSQL & " WHERE " & pItem & IIf(pUpDown, " > ", " < ") & IIf
(VarType(varHold) = 8, "'", "") & varHold & IIf(VarType(varHold) = 8, "'", "")
strSQL = strSQL & " ORDER BY " & pItem & IIf(pUpDown, "", " Desc")
'Debug.Print strSQL
'Create query def
On Error Resume Next
tName = IIf(IsMissing(qname), "qryXOXOX", qname)
'Does query tName exist? If true, delete it;
test = db.QueryDefs(tName).Name
If Err <> 3265 Then
docmd.DeleteObject acQuery, tName
End If
'Create/recreate query tName
Set qd = db.CreateQueryDef(tName, strSQL)
db.QueryDefs.Refresh
rs.Close
db.Close
Set db = Nothing
End Sub
Bob