-
Dec 5th, 2017, 02:16 PM
#1
Ideas for Locating a missing/unused record in a RecordSet
Think some of you might have done this and I have a solution, but wondering if there are others, possibly better overall?
The scenario: I have a disconnected recordset, not tied to any database. Within it, there is a field that can contain values within a fixed range. Looking for efficient ways of locating an available/unused item within that range.
For argument sake, we'll say the range is 0 to 65535. And the recordset's field "ID" field contains values within that range. The value can be anywhere within that range, user-defined. Therefore automating can't be done. However, the goal here is to auto-select a default if the user doesn't care which ID is used.
The logic for the above is simple: If user doesn't care, we can select a value that is before the lowest or after the highest used so far, unless the range's Min/Max (0 & 65535) are already used.
My solution is a binary search within the recordset. Haven't attempted a binary search for missing/unused items before, so not sure it's the best option; though it was fun developing it. We'll assume at least a few dozen range items are being used, but in the test, we are using all but one range item
Code:
Private Function BinaryTestRS(RS As ADODB.Recordset, IDField As Long) As Long
' Passed RS should be a clone if you don't want the recordset positions moving around: yourRS.Clone
' Assumptions:
' The range of items in the recordsest is assumed to be missing at least one item
' RangeMax - RangeMin + 1 > recordset.RecordCount
' The min/max range items are assumed already in use, else those should be used instead of calling this routine
' recordset.MoveLast: If RangeMax > recordset.Fields(x).Value Then use recordset.Fields(x).Value + 1
' recordset.MoveFirst: If recordset.Fields(x).Value > RangeMin Then use recordset.Fields(x).Value - 1
' In other words, this routine assumes record @ .MoveFirst is RangeMin and record @ .MoveLast is RangeMax
' Return value will be a value between RangeMin & RangeMax
' If the recordset is 100% full, no available values between RangeMin & RangeMax. Return value is RangeMin-1
Dim UB As Long, LB As Long, newIndex As Long
Dim recUB As Long, recNext As Long
Dim lIterations As Long ' testing
RS.Sort = "[" & RS.Fields(IDField).Name & "]"
RS.MoveLast
UB = RS.AbsolutePosition ' get nr of records
recUB = RS.Fields(IDField).Value ' and cache value of last record
RS.MoveFirst ' ensure the implied range is not 100% full
If UB >= recUB - RS.Fields(0).Value + 1 Then
BinaryTestRS = RS.Fields(0).Value - 1
Exit Function
End If
LB = 1
Do Until LB > UB: lIterations = lIterations + 1
newIndex = LB + ((UB - LB) \ 2) ' set position to look at & get value at that position
RS.Move newIndex - RS.AbsolutePosition: recNext = RS.Fields(IDField).Value
RS.MovePrevious
If recNext - RS.Fields(IDField).Value > 1 Then Exit Do ' check for gap of 1+ & exit if found
If recUB - recNext = UB - newIndex Then ' no gaps in this range, move to lower range
UB = newIndex - 1 ' set upper limit for next range & get value at that position
recUB = RS.Fields(IDField).Value
Else ' zeroing in on the range
LB = newIndex + 1
End If
Loop
' newIndex will be the record after the available item.
' Recordset is already positioned at newIndex-1. We just add 1 to that value & done.
' Note: If the gap at this position is > 1, then multiple consecutive values are available.
BinaryTestRS = RS.Fields(IDField).Value + 1
Debug.Print "iterations used to find missing item below:"; lIterations
End Function
And a simple test routine...
1. Add the Microsoft ActiveX Data Objects library to a test project
2. Add a button to the form
3. Copy the above routine
4. In the button's click event
Code:
Dim RS As ADODB.Recordset, crs As ADODB.Recordset
Dim x As Long, p As Long
Set RS = New ADODB.Recordset
RS.Fields.Append "RecID", adInteger
RS.Open
For x = 30001 To 65535 ' fill up the range 0-65535
RS.AddNew
RS.Fields(0).Value = x
Next
For x = 0 To 30000
RS.AddNew
RS.Fields(0).Value = x
Next
RS.UpdateBatch
For x = 1 To 20 ' randomly pick a record to delete
p = Int(Rnd * 65535) + 1
If p = 1 Or p = 65535 Then
Debug.Print "binary search not called, use ID;p"
Else
RS.Move p - 1, 1 ' move to record
p = RS.Fields(0) ' cache so we can re-add it later
RS.Delete ' delete it
RS.Update
Set crs = RS.Clone ' see if binary routine can find missing item
Debug.Print "deleted ID"; p; " found "; BinaryTestRS(crs, 0)
RS.AddNew
RS.Fields(0).Value = p ' add it back; won't be in any sort order
RS.Update
crs.Close: Set crs = Nothing
End If
Next
RS.Close: Set RS = Nothing
End Sub
-
Dec 5th, 2017, 03:55 PM
#2
Re: Ideas for Locating a missing/unused record in a RecordSet
These efforts (looking for gaps in an Rs-ID-Range) are IMO not necessary,
when you make use of already available features of the ADO-Recordset:
Wouldn't it be nice, when a (disconnected, or ClientCursor-based) Rs would support a kind of "snapshot" -
and then internally doing a "record-keeping" of what was changed (literally)?
That would allow us, to find deleted Records (as well as newly added ones) -
and thus we'd be able to come up at any time, with a list of "free IDs".
Well, the following example shows what an ADO-Rs has to offer in that regard::
Code:
Option Explicit
Private Rs As ADODB.Recordset
Private Sub Form_Load()
Caption = "Click Me"
Set Rs = New ADODB.Recordset
Rs.Fields.Append "ID", adInteger
Rs.Open
Dim ID As Long
For ID = 30001 To 65535: Rs.AddNew 0, ID: Next
For ID = 0 To 30000: Rs.AddNew 0, ID: Next
Rs.UpdateBatch 'now, let's make a "snap-shot" of the status-quo
End Sub
Private Sub Form_Click()
If FindRec(Rs, "ID=5") Then Rs.Delete 'find and delete the Record with ID=5
Rs.AddNew: Rs!ID = 5 '(re)-add a Record with the same ID=5
If FindRec(Rs, "ID=3") Then 'find ID=3 and invert it to -3
Rs!ID = -3
ElseIf FindRec(Rs, "ID=-3") Then 'if not found, search for ID=-3 and invert it again
Rs!ID = 3
End If
PrintChangedRecords Rs 'and here's where "the magic" happens
End Sub
'just two little Helper-Routines for more convenience
Function FindRec(Rs As ADODB.Recordset, Criterion As String) As Boolean
Rs.Find Criterion, , , adBookmarkFirst
If Not (Rs.EOF Or Rs.BOF) Then FindRec = True
End Function
Private Sub PrintChangedRecords(Rs As ADODB.Recordset)
AutoRedraw = True: Cls
With Rs.Clone
.Filter = adFilterPendingRecords '<- this being the Filter-Option, many are not aware of
Do Until .EOF
Select Case .Status
Case adRecDeleted: Print "Found Deleted -> Orig-IDValue: "; !ID.OriginalValue
Case adRecNew: Print "Found Added -> New-IDValue: "; !ID.Value
Case adRecModified: Print "Modified -> Orig-IDValue: "; !ID.OriginalValue; " Actual-IDValue: "; !ID.Value
End Select
.MoveNext
Loop
End With
End Sub
HTH
Olaf
-
Dec 5th, 2017, 04:01 PM
#3
Re: Ideas for Locating a missing/unused record in a RecordSet
Olaf, the recordset is an existing file that I have no full control over. I didn't mention that in the first post and probably should've; my bad. Your solution is interesting nonetheless, but doesn't quite fit my situation.
Additionally, you are tracking changes. There will likely exist thousands of available/unused items relative to the recordset. I just need to pick one and want to avoid a linear search as there also could be many items already in use. With the binary search, in the 65K example, a max of 16 iterations will be used. So, a quick and dirty rule of thumb: recordset less than 20, linear search, else use a more efficient algo.
-
Dec 5th, 2017, 04:12 PM
#4
Re: Ideas for Locating a missing/unused record in a RecordSet
Originally Posted by LaVolpe
Olaf, the recordset is an existing file that I have no full control over. I didn't mention that in the first post and probably should've; my bad.
Your solution is interesting nonetheless, but doesn't quite fit my situation.
I'd say it can be easily adapted to fit also for your scenario
(I'd write an example, when you'd post your "existing file" (or something like it) and a bit more info, what the purpose of the exercise is.
Olaf
-
Dec 5th, 2017, 04:22 PM
#5
Re: Ideas for Locating a missing/unused record in a RecordSet
Can't upload a real example; data not public use. However, simply create a recordset (1 field) having 5+ blocks of records where each block contains say 10 consecutive values, i.e., 0,1,2,3,5,6,7,8,9 50,51,52,53,54,55,56,57,58,59 etc.
As it stands now, I have no need to track any data while being added to the recordset; no need to even look at those fields as they are imported especially since I don't have control over them, other to later add/edit/delete them as user requests. Keeping a list of unused items is not an option and that list can exceed the count of items actually used. The task is really simple. Given a list, find a gap between any two consecutive values in the list. Binary searches are relatively quick. Options do exist with SQL queries, but not applicable to disconnected recordsets.
Edited: the example in 1st post is absolute worst-case scenario... only 1 available item left to be selected.
Last edited by LaVolpe; Dec 5th, 2017 at 04:26 PM.
-
Dec 5th, 2017, 04:25 PM
#6
Re: Ideas for Locating a missing/unused record in a RecordSet
I didn't follow the "user cares, user doesn't care" part.
If the user "cares" what does that mean? Return the next larger unused value if the one the user cares about exists?
If the user doesn't care just return any unused value?
-
Dec 5th, 2017, 04:27 PM
#7
Re: Ideas for Locating a missing/unused record in a RecordSet
User cares... They will assign a value for newly appended items
User doesn't care... auto-select the value for them. User can change it later if desired. Typical if appending multiple items at once.
Edited: Details may be a distraction...
Given a list, find a gap between any two consecutive values in the list. Contiguous items in the list can be dozens upon dozens. Looking for different techniques, especially if sorting is optional. But being a recordset, 1/2 million items can be sorted quickly, so asking for solutions on unsorted lists is unrealistic. I'd think a linear search would be last resort.
Last edited by LaVolpe; Dec 5th, 2017 at 04:36 PM.
-
Dec 5th, 2017, 09:45 PM
#8
Re: Ideas for Locating a missing/unused record in a RecordSet
Originally Posted by LaVolpe
Can't upload a real example; data not public use. However, simply create a recordset (1 field) having 5+ blocks of records where each block contains say 10 consecutive values, i.e., 0,1,2,3,5,6,7,8,9 50,51,52,53,54,55,56,57,58,59 etc.
Well, I see better now what you're trying to do (you're not trying to "work backwards" from a fully settled range, for which my suggestion in #2 would work quite well).
Originally Posted by LaVolpe
The task is really simple. Given a list, find a gap between any two consecutive values in the list. Binary searches are relatively quick.
It is indeed not really complicated - but the way your algo is currently implemented - the search is not quick at all.
Here is an example (for your suggested range of [1-0.5Mio] Records in the Rs) -
the Timings from an (MS-Scripting)-Dictionary-based "Free-ID-List" approach:
Here is your BinSearch-approach in comparison (had to reduce the range by factor 100, to only [1-5Tsd] Records):
To test that yourself, you need a Form with two CommandButtons (Command1 and Command2) -
plus added references to MS-ASO and the MS-Scripting-Dictionary...
Into the TestForm then:
Code:
Option Explicit
Private Sub Form_Load()
Caption = "Test-Form": FontSize = 10: FontName = "Arial": AutoRedraw = True
Command1.Caption = "Dictionary"
Command2.Caption = "BinSearch"
End Sub
Private Sub Command1_Click()
Cls
Dim Rs As New ADODB.Recordset, FreeIds As New cFreeIDs1, T!, n&
Rs.Fields.Append "ID", adInteger
Rs.Open
Dim ID As Long 'LB=1, UB=500000, Gaps: [100001-200000],[300001-400000]
For ID = 400001 To 500000: Rs.AddNew 0, ID: Next
For ID = 1 To 100000: Rs.AddNew 0, ID: Next
For ID = 200001 To 300000: Rs.AddNew 0, ID: Next
Rs.UpdateBatch
Print vbLf; "Dictionary-approach: on an Rs-Range of 1 to 500000"
Print vbLf; "Free-Ids-preparation:": DoEvents: T = Timer 'just to measure, how long it takes to bind and prepare the Helper-Object
FreeIds.BindTo Rs, "ID"
Print " RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
Print vbLf; "AddNew/Delete-pair:": DoEvents: T = Timer
For n = 1 To 100000 'let's do (100000 times) a basically non-Rs-changing "Double-Op"...
FreeIds.AddNew Rs 'performing an AddNew (with one of the free IDs)
FreeIds.Delete Rs 'followed by a Delete on the same (just added) Record of our Rs
Next
Print " RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
Print vbLf; "AddNew until full:": DoEvents: T = Timer
For n = 1 To FreeIds.Count 'well, now we get serious and add new Records, till there are no free IDs anymore
FreeIds.AddNew Rs
Next
Print " RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
Rs.Sort = "ID": n = 1 'sanity-checks on the final Rs-Content
If Rs.RecordCount <> 500000 Then MsgBox "shouldn't happen"
Do Until Rs.EOF
If Rs.Fields(0) <> n Then MsgBox "shouldn't happen"
Rs.MoveNext: n = n + 1
Loop
End Sub
Private Sub Command2_Click()
Cls
Dim Rs As New ADODB.Recordset, FreeIds As New cFreeIDs2, T!, n&
Rs.Fields.Append "ID", adInteger
Rs.Open
Dim ID As Long 'LB=1, UB=5000, Gaps: [1001-2000],[3001-4000]
For ID = 4001 To 5000: Rs.AddNew 0, ID: Next
For ID = 1 To 1000: Rs.AddNew 0, ID: Next
For ID = 2001 To 3000: Rs.AddNew 0, ID: Next
Rs.UpdateBatch
Print vbLf; "BinSearch-approach: on an Rs-Range of 1 to 5000"
Print vbLf; "Free-Ids-preparation:": DoEvents: T = Timer 'just to measure, how long it takes to bind and prepare the Helper-Object
FreeIds.BindTo Rs, "ID"
Print " RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
Print vbLf; "AddNew/Delete-pair:": DoEvents: T = Timer
For n = 1 To 1000 'let's do (1000 times) a basically non-Rs-changing "Double-Op"...
FreeIds.AddNew Rs 'performing an AddNew (with one of the free IDs)
FreeIds.Delete Rs 'followed by a Delete on the same (just added) Record of our Rs
Next
Print " RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
Print vbLf; "AddNew until full:": DoEvents: T = Timer
For n = 1 To 2000 'well, now we get serious and add new Records, till there are no free IDs anymore
FreeIds.AddNew Rs
Next
Print " RecordCount: " & Rs.RecordCount & ", FreeIds.Count: " & FreeIds.Count & ", Timing: " & Format$((Timer - T) * 1000, "0msec")
Rs.Sort = "ID": n = 1 'sanity-checks on the final Rs-Content
If Rs.RecordCount <> 5000 Then MsgBox "shouldn't happen"
Do Until Rs.EOF
If Rs.Fields(0) <> n Then MsgBox "shouldn't happen"
Rs.MoveNext: n = n + 1
Loop
End Sub
Into a Class cFreeIds1 (for the Dictionary-based approach):
Code:
Option Explicit
Private mFieldName As String, mD As New Scripting.Dictionary
Public Sub BindTo(Rs As ADODB.Recordset, FieldName As String, Optional LB, Optional UB)
mFieldName = FieldName
With Rs.Clone
Dim F As ADODB.Field, B() As Byte, i As Long
Set F = .Fields(mFieldName)
.Sort = "[" & mFieldName & "]"
.MoveLast: UB = F.Value
.MoveFirst: LB = F.Value
ReDim B(LB To UB)
Do Until .EOF: B(F.Value) = 1: .MoveNext: Loop
End With
Set mD = Nothing
For i = LB + 1 To UB - 1
If B(i) = 0 Then mD.Add i, i
Next
End Sub
Public Property Get Count() As Long
Count = mD.Count
End Property
Public Function AddNew(Rs As ADODB.Recordset, Optional ID)
If Count = 0 Then Err.Raise vbObjectError, , "No free IDs available anymore..."
For Each ID In mD
Rs.AddNew mFieldName, ID: Exit For 'fill the ByRef-ID (in case someone on the outside is interested)
Next
Rs.Update: mD.Remove ID
End Function
Public Function Delete(Rs As ADODB.Recordset, Optional ID)
If Rs.RecordCount = 0 Then Err.Raise vbObjectError, , "No Records to delete"
If Rs.EOF Or Rs.BOF Then Err.Raise vbObjectError, , "Either EOF or BOF is true"
ID = Rs(mFieldName).Value
mD.Add ID, ID
Rs.Delete: Rs.Update
End Function
Into a Class cFreeIds2 (for your BinSearch-based approach):
Code:
Option Explicit
Private mFieldName As String, mLB As Long, mUB As Long
Public Sub BindTo(Rs As ADODB.Recordset, FieldName As String, Optional LB, Optional UB)
mFieldName = FieldName
With Rs.Clone 'fill the ByRef-Params (in case someone is interested on the outside)
.Sort = "[" & mFieldName & "]"
.MoveLast: UB = .Fields(mFieldName).Value
.MoveFirst: LB = .Fields(mFieldName).Value
End With
mLB = LB
mUB = UB
End Sub
Public Property Get Count()
Count = "not available" 'with the choosen approach
End Property
Public Function AddNew(Rs As ADODB.Recordset, Optional ID)
ID = BinaryTestRS(Rs) 'fill the ByRef-ID (in case someone on the outside is interested)
If ID >= mLB Then
Rs.AddNew mFieldName, ID
Rs.Update
End If
End Function
Public Function Delete(Rs As ADODB.Recordset, Optional ID)
If Rs.RecordCount = 0 Then Err.Raise vbObjectError, , "No Records to delete"
If Rs.EOF Or Rs.BOF Then Err.Raise vbObjectError, , "Either EOF or BOF is true"
ID = Rs(mFieldName).Value
Rs.Delete: Rs.Update
End Function
Private Function BinaryTestRS(ByVal Rs As ADODB.Recordset) As Long
' Assumptions:
' The range of items in the recordsest is assumed to be missing at least one item
' RangeMax - RangeMin + 1 > recordset.RecordCount
' The min/max range items are assumed already in use, else those should be used instead of calling this routine
' recordset.MoveLast: If RangeMax > recordset.Fields(x).Value Then use recordset.Fields(x).Value + 1
' recordset.MoveFirst: If recordset.Fields(x).Value > RangeMin Then use recordset.Fields(x).Value - 1
' In other words, this routine assumes record @ .MoveFirst is RangeMin and record @ .MoveLast is RangeMax
' Return value will be a value between RangeMin & RangeMax
' If the recordset is 100% full, no available values between RangeMin & RangeMax. Return value is RangeMin-1
Dim UB As Long, LB As Long, newIndex As Long
Dim recUB As Long, recNext As Long, F As ADODB.Field
Dim lIterations As Long ' testing
Set Rs = Rs.Clone 'we make the clone directly here (from a Byval passed Rs-ObjPtr)
Set F = Rs.Fields(mFieldName)
Rs.Sort = "[" & F.Name & "]"
Rs.MoveLast
UB = Rs.AbsolutePosition ' get nr of records
recUB = F.Value ' and cache value of last record
Rs.MoveFirst ' ensure the implied range is not 100% full
If UB >= recUB - F.Value + 1 Then
BinaryTestRS = F.Value - 1
Rs.Close
Exit Function
End If
LB = 1
Do Until LB > UB
lIterations = lIterations + 1
newIndex = LB + ((UB - LB) \ 2) ' set position to look at & get value at that position
Rs.Move newIndex - Rs.AbsolutePosition: recNext = F.Value
Rs.MovePrevious
If recNext - F.Value > 1 Then Exit Do ' check for gap of 1+ & exit if found
If recUB - recNext = UB - newIndex Then ' no gaps in this range, move to lower range
UB = newIndex - 1 ' set upper limit for next range & get value at that position
recUB = F.Value
Else ' zeroing in on the range
LB = newIndex + 1
End If
Loop
' newIndex will be the record after the available item.
' Recordset is already positioned at newIndex-1. We just add 1 to that value & done.
' Note: If the gap at this position is > 1, then multiple consecutive values are available.
BinaryTestRS = F.Value + 1
Rs.Close
'Debug.Print "iterations used to find missing item below:"; lIterations
End Function
The two Classes are calling-compatible (Interface-wise) - though in your approach the "FreeIDs-Count" is not available of course...
Tried already to optimize your approach a bit (but didn't try real hard) - maybe you can squeeze more out of it.
(FWIW, you now have something to compare it to...).
Olaf
-
Dec 6th, 2017, 06:16 AM
#9
Re: Ideas for Locating a missing/unused record in a RecordSet
Hi,
I can't see any advantage in doing this (search a range for a number)
here what I use for getting Table Information regarding ID's und how many records are in the Table
I use ADOX
for getting the next available ID (Autoincrement)
Code:
Private Sub Command10_Click()
'Get the next available ID
Dim Cat As ADOX.Catalog
Dim Tbl As ADOX.Table
Dim Col As ADOX.Column
Dim Cn As ADODB.Connection
Dim strPathToDB As String
strPathToDB = "D:\Northwind.mdb"
Set Cn = New ADODB.Connection
With Cn
.CursorLocation = adUseClient
.Mode = adModeShareDenyNone
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = strPathToDB
' if Password :
'.Properties("Jet OLEDB:Database Password") = "testdb"
' if System- und Securety-MDW
' .Properties("Jet OLEDB:System database") = "D:\Test_DBs\Access\db3.mdw"
' UserId // User
'.Properties("User ID") = "xyz"
' Password for Users
'.Properties("Password") = "myPass"
.Open
End With
Set Cat = New ADOX.Catalog
Cat.ActiveConnection = Cn
Set Tbl = Cat.Tables("Employees")
Set Col = Tbl.Columns("EmployeeID")
'method 1:
'MsgBox Col.Properties("Seed").Value
'method 2:
MsgBox Cat("Employees")("EmployeeID").Properties("Seed").Value
End Sub
for Table Information..
Code:
Private Sub Command6_Click()
GetTableInfo Cn, "Employees"
End Sub
Public Function GetTableInfo(Cn As ADODB.Connection, _
sTable As String, _
Optional RecordCount As Long, _
Optional DateCreated As Date, _
Optional DateModified As Date) As Boolean
Dim Rs As ADODB.Recordset
'Filter: pass Table name for Information
Set Rs = Cn.OpenSchema(adSchemaTables, _
Array(Empty, Empty, sTable, "Table"))
If Rs.EOF Or Rs.BOF Then
Rs.Close
Set Rs = Nothing
Exit Function
End If
DateCreated = Rs.Fields("Date_Created").Value
DateModified = Rs.Fields("Date_Modified").Value
Debug.Print Rs.Fields("Date_Created").Value
Debug.Print Rs.Fields("Date_Modified").Value
Set Rs = Cn.OpenSchema(adSchemaStatistics, _
Array(Empty, Empty, sTable))
RecordCount = Rs.Fields("Cardinality").Value 'get how many Records
Debug.Print Rs.Fields("Cardinality").Value
GetTableInfo = True
Rs.Close
Set Rs = Nothing
End Function
one could also create a new Table with a specific AutoID starting at a specific Number ( say 50000)
Code:
Private Sub Command24_Click()
Dim strSQL As String
'start AutoID where you want. MyID is the Autoincrement value
strSQL = "Insert Into tbl_IdStartwith (MyID,myName) Values (49999,'Test')"
Cn.Execute strSQL
End Sub
regards
Chris
Last edited by ChrisE; Dec 6th, 2017 at 06:32 AM.
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Dec 6th, 2017, 07:45 AM
#10
Re: Ideas for Locating a missing/unused record in a RecordSet
@Chris. Already mentioned, this is a disconnected recordset, not related to a database.
@Olaf. Will look closer at your solution. Though I will admit, not keen on building some lookup object to store additional information that may not be used or not used often.
-
Dec 6th, 2017, 09:00 AM
#11
Re: Ideas for Locating a missing/unused record in a RecordSet
Originally Posted by LaVolpe
@Chris. Already mentioned, this is a disconnected recordset, not related to a database.
Hi,
then I don't understand it at all.
what do you do with the Data ? do you reconnect to some Table in a Database ?
regards
Chris
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Dec 6th, 2017, 09:11 AM
#12
Re: Ideas for Locating a missing/unused record in a RecordSet
Chris. A disconnected recordset can be used for far more things than relating to some database table. Anything you can think of that can be used by a single Excel sheet, can also be used via a recordset. It's just a collection of data and can be persisted to file in recordset format and read later as needed.
-
Dec 6th, 2017, 10:09 AM
#13
Re: Ideas for Locating a missing/unused record in a RecordSet
Yes, fabricated Recordsets can be a useful alternative to Collection, Scripting.Dictionary, and similar classes.
They can be indexed and sorted at the Field level, can hold multiple values, support filtering, can even be persisted to disk and later loaded from disk. They can also save/load using a Stream object, which makes it easy to transmit them via TCP or HTTP.
See the attachment "Disconnecting ADO" here: http://www.vbforums.com/showthread.p...=1#post4843967
I don't know of anywhere else on the web that has this classic PowerPoint online anymore.
-
Dec 6th, 2017, 11:09 AM
#14
Re: Ideas for Locating a missing/unused record in a RecordSet
Hi,
@LaVolpe got it now
@dillettante, thanks for Link, it is a good read.
I sometimes use offline Recordsets, when reconnecting to the Table an Update takes place.
thanks to both of you
regards
Chris
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Dec 6th, 2017, 01:41 PM
#15
Re: Ideas for Locating a missing/unused record in a RecordSet
@dilettante. Nice PPT presentation. Didn't know about the Optimize property.
-
Dec 6th, 2017, 02:14 PM
#16
Re: Ideas for Locating a missing/unused record in a RecordSet
A comprehensive guide on disconnected recordsets would have been nice, not sure if I have anything like that handy.
The PPT touched on adMashalModifiedOnly, but it didn't cover how to control what SQL is generated, like the WHERE condition that tests if modified values were changed on the server before applying the new value.
-
Dec 7th, 2017, 06:21 AM
#17
Re: Ideas for Locating a missing/unused record in a RecordSet
Originally Posted by LaVolpe
Chris. A disconnected recordset can be used for far more things than relating to some database table. Anything you can think of that can be used by a single Excel sheet, can also be used via a recordset. It's just a collection of data and can be persisted to file in recordset format and read later as needed.
Hi,
this concept of searching for Number(s) in a Range is bugging me. Let's take your example with the Excel Sheet
what would the Sheet contain and how would the Sheet look like.
EDIT:
I just set up a Excelsheet with some Numbers and a Status.
then this...
Code:
Private Sub Form_Load()
On Error GoTo ErrHandler
Set cn = New ADODB.Connection
' -- connection provider
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.ConnectionString = _
"Data Source=C:\UsedRangeNumber.xls;" & _
"Extended Properties=Excel 8.0;"
cn.CursorLocation = adUseClient
cn.Open
Exit Sub
ErrHandler:
MsgBox "Connection-Fehler"
End Sub
Private Sub Command2_Click()
Set rs = New ADODB.Recordset
rs.Open "SELECT Status, Number From [Tabelle1$] Where Status ='not used' AND Number Between 50 And 250 ", cn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rs
End Sub
Edit: more Sql
Private Sub Command3_Click()
Set rs = New ADODB.Recordset
'1) get lowest number not used in range
'rs.Open "SELECT Top 1 Status, Number From [Tabelle1$] Where Status ='not used' AND Number Between 50 And 345 ", cn, adOpenDynamic, adLockOptimistic
'2) get numbers in range not used
rs.Open "SELECT Status, Number From [Tabelle1$] Where Status ='not used' AND Number Between 50 And 345 ORDER BY Number DESC;", cn, adOpenDynamic, adLockOptimistic
'3) get highest number not used in Range
'rs.Open "SELECT Max(Number) AS [LastNumber], Status" & _
" From [Tabelle1$]" & _
" WHERE (((Number) Between 50 And 345))" & _
" GROUP BY Status" & _
" HAVING (((Status)='not used'))", cn, adOpenDynamic, adLockOptimistic
Set DataGrid1.DataSource = rs
End Sub
regards
Chris
Last edited by ChrisE; Dec 7th, 2017 at 08:18 AM.
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|