requery_with_position_return

Sometimes we have scenarios where we want to change a record, in ways that might cause it to “shift” its logical position within a dataset, or maybe even disappear. To take an example think of dismissing a notation. To make the record disappear we need to requery the dataset. The problem is, that this causes the recordset cursor to return to the top. We can try to re-locate the record after the requery, but in this case the record is gone, so how far should we scroll down the recordset?

 

Or what if we are changing a field value of a column which we are sorting by? We might want to re-locate the record, after doing our requery. Either way, the following code should return to the same record (or spot if the record is gone). Give a go and let me have your feedback in the comments section.

 

Version 1:

Option Compare Database
Option Explicit
Private mCurrentSectionTop As Long
Private mCursorline As Long
Private mCursorWhere As String
Private mPosition As Long
Private has_code_on_current As Boolean

Public Sub disable_current_event(frm As Form)
   has_code_on_current = (frm.OnCurrent = "[Event Procedure]")
   If has_code_on_current Then
      frm.OnCurrent = ""
   End If
End Sub
Public Sub restore_current_event(frm As Form)
   If has_code_on_current Then
      frm.OnCurrent = "[Event Procedure]"
   End If
   
End Sub
Public Sub requery_with_position_return(frm As Form, pk_fieldname As String)
On Error GoTo Error_handler
   
   frm.Painting = False
   If frm.Recordset.BOF And frm.Recordset.EOF Then
      'There are no records in form, so nowhere to return to. Just requery
      frm.Requery
   Else
      disable_current_event frm
      mCurrentSectionTop = frm.CurrentSectionTop
      mCursorline = (frm.CurrentSectionTop - frm.Section(acHeader).Height - 5) / (frm.Section(acDetail).Height - 1)
      Select Case dao_field_type_to_string_simple(frm.Recordset.Fields(pk_fieldname))
         Case "integer"
               mCursorWhere = pk_fieldname & "=" & frm.Recordset.Fields(pk_fieldname)
         Case "decimal"
                  mCursorWhere = pk_fieldname & "=" & Replace(frm.Recordset.Fields(pk_fieldname).Value, ",", ".") 'Replace , with . as that is used in some regions, and SQL expects .
         Case "Text"
            mCursorWhere = pk_fieldname & "=""" & frm.Recordset.Fields(pk_fieldname).Value & """" 'Pad with double quotes
         Case "date"
            mCursorWhere = pk_fieldname & "=#" & Format(frm.Recordset.Fields(pk_fieldname).Value, "yyyy\-mm\-dd hh\:nn\:ss") & "#" 'Format data as the SQL engine expects it
         Case Else
            Err.Raise "666", , "field data type not supported"
      End Select
   
      mPosition = frm.Recordset.AbsolutePosition
      frm.Requery
      If Not frm.Recordset.EOF Then
         With frm.Recordset
            '.MoveLast
            .FindFirst mCursorWhere
            If .NoMatch Then 'No longer in this recordset
               .Move mPosition 'Move to last known location
               If mCursorline = 0 Then mCursorline = 1
                  .Move -mCursorline
                  .Move mCursorline
               
            Else
               .Move CInt(frm.InsideHeight / (frm.Section(acDetail).Height - 1)) 'Move a screen down from that record
               .FindFirst mCursorWhere
               .Move -mCursorline
               .FindFirst mCursorWhere
            End If
         End With
      End If
      restore_current_event frm
      If has_code_on_current Then
         Call frm.Form_Current ''Warning: Must ensure this event is public
      End If
   End If
   frm.Painting = True
exit_Sub:
    'Cleanup

        On Error GoTo 0
        Exit Sub

exit_with_requery:
   On Error Resume Next
   frm.Requery
   GoTo exit_Sub

Error_handler:
      'Make sure painting is re-enabled
         If Not frm.Painting Then frm.Painting = True
   restore_current_event frm
   
    Select Case Err.Number
         Case 3001, 3021 '3001:Invalid property and 3021:No current record. (Record might have been deleted)
           
            GoTo exit_with_requery 'TODO handle this better, like returning to current postion in the scrollbar
            
        Case Else
         'We rethrow the error, such that the calling procedure is informed of the error
            Err.Raise Err.Number, , "An error occured in procedure [requery_with_position_return]" & vbNewLine & Err.Description
    End Select
    Resume exit_Sub
    Resume 'This line used for debuging during development.

End Sub




Public Function dao_field_type_to_string_simple(fld As Object) As String
'Purpose: Return a simplefied description of the field type, whether its number, string, decimal, boolean
'Supports late binding
   Select Case fld.Type
      'Simple numbers
         Case 1, 3, 4, 16 '3=dbInteger,4=dbLong,16=dbBigInt
            dao_field_type_to_string_simple = "Integer"
      
      'Numbers with decimal points we group as decimal
         Case 5, 6, 7, 19, 20, 21 ''5=dbCurrency, 6=dbSingle,7=dbDouble,19=dbNumeric,20=dbDecimal,21=dbFloat
            dao_field_type_to_string_simple = "Decimal"
      
      'Text Type fields
         Case 10, 12, 18 '10=dbText, 12=dbMemo, 18=dbChar
            dao_field_type_to_string_simple = "Text"
               
      'Date
         Case 8, 22 '8=dbDate, 22=dbTime
            dao_field_type_to_string_simple = "Date"

      'Complex formats
         Case 9, 11, 17 '9=dbBinary,11=dbLongBinary, 17=dbVarBinary
            dao_field_type_to_string_simple = "Binary"
         Case 15 '15=dbGUID
            dao_field_type_to_string_simple = "GUID"
         Case 13 '13=dbTimeStamp
            dao_field_type_to_string_simple = "TimeStamp"
            
      'Other (This could be grouped with Integer as well perhaps...)
         Case 2 '2=dbByte
            dao_field_type_to_string_simple = "Byte"
            
      Case Else
         dao_field_type_to_string_simple = "OTHER"
   End Select
   
End Function

And calling it is really as simple as

requery_with_position_return me,'NameOfPrimaryKeyField'

 

Note that instead of using ME, you can pass in a form reference if you wish to requery another form than the one running the code.

It should support most datatypes, including dates, strings and of course long (autonumber)

3 comments on “requery_with_position_return
  1. Giorgio says:

    So
    requery_with_position_return me,’NameOfPrimaryKeyField’ would be called by the AfterUpdate event of the field we’re updating?

    • TheSmileyCoder says:

      That could be one option. E.g. if your form is showing all Open Tasks, and you change a task status to closed (And want it to disappear from the list) you could use this to accomplish that, and in that case the afterupdate event could be used.

  2. memphismaven says:

    I am so glad you are back!! Your posts are incredibly helpful.

Leave a Reply

Your email address will not be published. Required fields are marked *

*

This site uses Akismet to reduce spam. Learn how your comment data is processed.