Requery a continious form while keeping position (ADP)

D

dWise

Hi All,

Found a way to requery a form while keeping te current record selected
(even after a delete)
(only tested in an 2k2 access project, no warranty)

Public Sub RequeryAndKeepPosition(ByRef objForm As Form)

Dim lngRecord As Long
Dim objRecordset As ADODB.Recordset
Dim strEvent As String

On Error GoTo Err_RequeryAndKeepPosition

'Disable painting of the form.
'By hiding the details section the scrollbars will not change after
'a Requery, why? ask microsoft.
strEvent = objForm.OnCurrent
objForm.Painting = False
objForm.Section(acDetail).Visible = False
objForm.OnCurrent = ""

'Remind the current position
lngRecord = objForm.Recordset.AbsolutePosition

'Make a clone (shadow copy)
Set objRecordset = objForm.RecordsetClone

'requery the clone (shadow copy)
objRecordset.Requery

'Discover if position is still valid
Select Case lngRecord
Case Is > objRecordset.RecordCount
objRecordset.MoveLast
Case Is < 1
objRecordset.MoveFirst
Case Else
objRecordset.AbsolutePosition = lngRecord
End Select

'Requery the form, only requiring the recordset will not work
objForm.Requery

'Wait until all records are fetched
While (objForm.Recordset.State > 1)
DoEvents
Wend

objForm.OnCurrent = strEvent

'Set the new position
objForm.Recordset.AbsolutePosition = objRecordset.AbsolutePosition

Exit_RequeryAndKeepPosition:
Set objRecordset = Nothing
objForm.Section(acDetail).Visible = True
objForm.Painting = True
Exit Sub

Err_RequeryAndKeepPosition:
msgbox err.description
Resume Exit_RequeryAndKeepPosition

End Sub

Hope this is usefull for anyone, this should be a standard feature in
access.

Regards,

Frans
 
Top