John Colby
jwcolby at ColbyConsulting.com
Sat Oct 29 15:39:34 CDT 2005
Folks,
First of all, let me once again thank Shamil whom I consider to be the
Father of AccessD Withevents usage, and who taught me everything I know
about the subject. Withevents is the single most useful undocumented
feature of Access AFAIAC. Withevents are DEAD EASY to understand, and make
available a whole class of functionality that you would otherwise be unable
to use. If you don't understand them yet, take this opportunity to learn
how they work.
I need a small control set to allow me to easily re-arrange the tables, and
the queries that modify the tables in the data migration tool I am building.
I therefore built a class to allow me to do this stuff. The class sinks the
click events for two command buttons, and raises its own event. The
operation of this thing is explained a little more below, and is also
documented in the header of the class.
This is a great demo of how WithEvents works, and is in fact a set of
controls that I will be using in the new data migration tool to allow me to
dynamically re-order the tables and queries to be processed in the order
necessary.
To download and look at this demo, go to my web site, register, login and
click on Example Code / Withevents Demo, then click on C2DbControlSets to
download the demo.
When the demo opens, the form will open with the three controls being
discussed. Click the up or down arrow to move selected record up or down in
the list.
Notice that the class raises its own event which is sunk in frmTestCtlGroups
and used to requery another form which displays the records in the table.
Thus this demo also shows how to raise an event in your own class, and how
to sink that event to do something useful with it. As you move any record
up/down through the list you can watch the other form and see it move, and
how the StepID is being manipulated.
##################
Each table will have a field which I shall call StepID for the purposes of
this email. The StepID field will be an integer, and will be consecutive
numbers within the recordset being "sorted". In other words:
The tblTable has a StepID field, and each record in tblTable will have a
value in this field, one more that the previous record.
The tblOperation will likewise have a StepID field in it. Because this
table is child to tblTable, there will be a SET of 1 or more records in
tblOperation for each record in tblTable. WITHIN THAT SET, the StepID field
will contain consecutive numbers.
The control set contains a list control to display the records or some
identifying piece such as the table name or the query name. The list will
have at least 3 columns - PKIDE, STEPID and the identifying field (table /
query name).
There is a WithEvents class to hold all processing code and data for this
control set. The form containing the data will dimension an instance of the
class and initialize it:
##################
Dim fdclsCtlLst_RecordMover As dclsCtlLst_RecordMover
Dim fcnn As ADODB.Connection
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Err_Form_Open
Set fcnn = CurrentProject.Connection
On Error Resume Next
fcnn.Properties("Jet OLEDB:Database Locking Mode") = 1
On Error GoTo Err_Form_Open
Set fdclsCtlLst_RecordMover = New dclsCtlLst_RecordMover
fdclsCtlLst_RecordMover.mInit lstTestOrder, cmdTestOrderUp,
cmdTestOrderDn, fcnn, "tblTestStep", "TBL_ID", "TBL_Step"
Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox Err.Description, , "Error in Sub
Form_frmTestCtlGroups.Form_Open"
Resume Exit_Form_Open
Resume 0 '.FOR TROUBLESHOOTING
End Sub
##################
And a cleanup to release the class
##################
Private Sub Form_Close()
Set fdclsCtlLst_RecordMover = Nothing
End Sub
##################
And an event sink for the fdclsCtlLst_RecordMover AfterClick event
##################
Private Sub fdclsCtlLst_RecordMover_AfterClick()
Forms("frmTestOrder").Requery
End Sub
##################
The code for the class receives variables in an init statement. The
variables include pointers to the specific list box and two command
controls, a connection object, and the name of the table containing the
StepID, the name of the PKID field, and the name of the StepID field.
Init() stores all of these things, then there are two OnClick event handlers
plus a method to do the work. That's all folks.
##################
Option Compare Database
Option Explicit
'
'This class implements a method of "moving" sorted records in a table where
the sort field is a
'an integer (StepID), and the order of the records need to be dynamically
moved using a visual tool.
'
'This object will be multi-user enabled by LOCKING two records at the
instant a button is clicked.
'If locks cannot be obtained for BOTH records, an error message will be
displayed and control
'will be returned to the user without anything done.
'
'Requirements:
'
'The list box Multi-select must be set to None, this class only moves one
record at a time
'PK of the table has to be a long (autonumber)
'Step field has to be an Integer
'The step field cannot have a unique id. Reason explained in a moment
'The list has to be populated with a query with:
' The PKID in the leftmost (1st) field
' The STEPID in the next field
' Any other information contained in the remaining fields
'The query must be sorted in StepID order
'
'The class works by physically writing TWO records every time an up/down
button is clicked
'
'If the focus is in the FIRST object in the list and the UP button is
clicked, nothing is done
'If the focus is in the LAST object in the list and the DOWN button is
clicked, nothing is done
'In any other case, adjacent records in the table whose name is passed in
will be modified
'
'
'There will be an instant in time when two records will have the same
StepID.
'Assume that RecordA has StepID of 21 and RecordB has a StepID of 22 (they
are adjacent)
'The process works by:
'
'1) Recording the current StepID of RecordA into a variable
'2) Then the StepID of RecordB is written into the StepID of RecordA
'3) Then the original StepID of RecordA is written into RecordB
'
'During the 2nd step above, two records have the same StepID. It is for
this reason that the
'StepID field cannot have a UniqueID
'
'In order to prevent this, the code would have to discover an unused StepID,
Temporarily setting
'the StepID of either RecordA or RecordB to the unused StepID, and fixing
things up later.
'This would add an additional write operation, and would require keeping the
locks in place longer.
'It CAN be done, but I am not doing this.
'
'If the UP button is clicked, the PK of the object ABOVE the object with the
focus will be retrieved from the list
'
Private mcnn As ADODB.Connection
Private WithEvents mlst As ListBox
Private WithEvents mcmdUp As CommandButton
Private WithEvents mcmdDn As CommandButton
Private mlngRec1ID As Long 'Rec1 will always be the CURRENTLY
SELECTED of the two records being worked with
Private mintRec1Step As Integer
Private mlngRec2ID As Long 'Rec2 will always be the RECORD BEING
EXCHANGED WITH of the two records being worked with
Private mintRec2Step As Integer
Private mstrTblName As String
Private mstrPKFldName As String
Private mstrStepFldName As String
Private Const cintColumnPKID As Integer = 0
Private Const cintColumnStepID As Integer = 1
Private Const cstrEventProc = "[Event Procedure]"
Public Event AfterClick()
'
'Cleanup all pointers to objects dimmed in this class
'
Private Sub Class_Terminate()
Set mlst = Nothing
Set mcmdUp = Nothing
Set mcmdDn = Nothing
End Sub
'
'Pass in pointers to objects that this class controls
'
'llst, lcmdUp and lcmdDn are the list control and the two command button
controls
'lcnn is a connection object for the database that the table is in
'lstrTblName is the name of the table that holds the StepField
'strPKFldName is the name of the PK field in lstrTblName - must be a long
integer (autonumber)
'lstrStepFldName is the name of the step field in lstrTblName
'
Function mInit(llst As ListBox, lcmdUp As CommandButton, lcmdDn As
CommandButton, _
lcnn As ADODB.Connection, lstrTblName As String,
lstrPKFldName As String, lstrStepFldName As String)
Set mlst = llst
Set mcmdUp = lcmdUp
Set mcmdDn = lcmdDn
Set mcnn = lcnn
mcmdUp.OnClick = cstrEventProc
mcmdDn.OnClick = cstrEventProc
mstrTblName = lstrTblName
mstrPKFldName = lstrPKFldName
mstrStepFldName = lstrStepFldName
End Function
Private Sub mcmdDn_Click()
UpdateRecords False
RaiseEvent AfterClick
End Sub
Private Sub mcmdUp_Click()
UpdateRecords True
RaiseEvent AfterClick
End Sub
Private Sub UpdateRecords(lblnUp As Boolean)
On Error GoTo Err_UpdateRecords
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Dim strSQL1 As String
Dim strSQL2 As String
Dim intListIndex As Integer
intListIndex = mlst.ListIndex
'
'Check if the item selected is the first item in the list and we are
moving up
'
If intListIndex = 0 Then
If lblnUp Then
GoTo Exit_UpdateRecords
End If
End If
'
'Check if the item selected is the last item in the list and we are
moving down
'
If intListIndex + 1 = mlst.ListCount Then
If Not lblnUp Then
GoTo Exit_UpdateRecords
End If
End If
mlngRec1ID = mlst.Column(cintColumnPKID, intListIndex)
mintRec1Step = mlst.Column(cintColumnStepID, intListIndex)
If lblnUp Then
intListIndex = intListIndex - 1
Else
intListIndex = intListIndex + 1
End If
mlngRec2ID = mlst.Column(cintColumnPKID, intListIndex)
mintRec2Step = mlst.Column(cintColumnStepID, intListIndex)
'
'Build up the SQL statement that will be used to lock and update the
records
'
strSQL1 = "SELECT " & mstrStepFldName & " FROM " & mstrTblName & " WHERE
" & mstrPKFldName & " = " & mlngRec1ID
strSQL2 = "SELECT " & mstrStepFldName & " FROM " & mstrTblName & " WHERE
" & mstrPKFldName & " = " & mlngRec2ID
'
'Open both recordsets to establish the locks
'
Set rst1 = New ADODB.Recordset
rst1.Open strSQL1, mcnn, adOpenStatic, adLockPessimistic
Set rst2 = New ADODB.Recordset
rst2.Open strSQL2, mcnn, adOpenStatic, adLockPessimistic
'
'Update the data in both records so that the locks on both are held
'
rst1(mstrStepFldName) = mintRec2Step
rst2(mstrStepFldName) = mintRec1Step
'
'And finally write the data of both records sequentially so that the
locks are released at the same time
'
rst1.Update
rst2.Update
'
'Requery the list box to reflect the changes
'
mlst.Requery
'
'And set the focus back to the object
'
'mlst.ListIndex = intListIndex
Exit_UpdateRecords:
On Error Resume Next
If Not (rst2 Is Nothing) Then rst2.Close: Set rst2 = Nothing
If Not (rst1 Is Nothing) Then rst1.Close: Set rst1 = Nothing
Exit Sub
Err_UpdateRecords:
Select Case Err
Case -2147217887
MsgBox "One of the records you want to move is being edited by
another user"
Resume Exit_UpdateRecords
Case Else
MsgBox Err.Description, , "Error in Sub
dclsCtlLst-RecordMover.UpdateRecords"
Resume Exit_UpdateRecords
End Select
Resume 0 '.FOR TROUBLESHOOTING
End Sub
##################
John W. Colby
www.ColbyConsulting.com
Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/