UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> ListDeleteRecord    


Synopsis

Use this procedure in a button control to delete records containing numbered/ordered lists. It renumbers the lists to fill any gaps the delete operation may produce prior to performing the delete operation. It is useful for sort order, priorities, or other situations when records require consecutively numbered values. Related procedures are ListRenumber, ListNewRecord, ListInitialize and ListFindFormTable. The ListFindFormTable is required.

NOTE: Arguments are Control Names. The Control Source of those controls must refer to actual field names (no aliases).

CODE
' ListDeleteRecord
' http://www.utteraccess.com/wiki/ListDeleteRecord
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2015-09-23                    
'
'*******************************************************************
'  Procedure to delete records, renumbering lists to fill any "gaps"
'  Procedure Arguments:
'           Key:  Control name containing the Primary Key
'     PairNames:  Parameter array listing control names.  These names
'              must be in pairs for controls governing Field to be renumbered
'              and Criteria Field giving the list to be renumbered, e.g.
'              ** Me.MainList.Name, "", Me.OrgList.Name, Me.OrgID.Name **
'              adjust a main/overall list for the table, and adjust
'              an Organization List for the Organization identified in OrgID
'              (Allows multiple 1-n lists to be maintained in the same record)
'  Notes:
'     Requires utility function ListFindFormTable
'     Use this procedure in a stand-alone button control
Public Sub ListDeleteRecord(Key As String, ParamArray PairNames() As Variant)
On Error GoTo ErrHndlr
  Dim frm As Form
  Dim sql As String, i As Long
  Dim msg As String, sTable As String, sKey As String
  Dim sOrder As String, sCrit As String
  Set frm = Application.CodeContextObject
  'ignore for new records, New Records do not necessaryily have all
  'of the required data
  If frm.NewRecord Then Exit Sub
  Select Case UBound(PairNames)
     Case 0, -1   '0=> only 1 parameter entered, -1 => no parameters entered
        msg = "At least 2 PairNames are required." & vbCr & _
           "The second may be an empty string ("""")."
     Case Else   ' more than 1 arg entered, but even number?
        If (UBound(PairNames) + 1 Mod 2) = 0 Then
           'odd number entered, must be even number
           msg = "The number of PairNames must be even."
        End If
  End Select
  If Len(msg) > 0 Then
     MsgBox msg, vbCritical
     End   'stop exection
  End If
  sTable = "[" & ListFindFormTable(frm) & "]"
  With frm.Controls(Key)
     sKey = "[" & .ControlSource & "]=" & .Value
  End With
  'renumber each list, 1 by 1
  For i = 0 To UBound(PairNames) Step 2
     'determine records to change
     'the order list
     With frm.Controls(PairNames(i))
        sOrder = "[" & .ControlSource & "]=[" & .ControlSource & "]"
        'ignore recs with Null or zero
        sCrit = " AND ([" & .ControlSource & "] Is Not Null Or [" & _
           .ControlSource & "]>0)"
     End With
     'the order list criteria
     If Len(Nz(PairNames(i + 1), "")) > 0 Then  'note adjust for Null
        With frm.Controls(PairNames(i + 1))
           'only records for this order list
           sCrit = sCrit & " AND [" & .ControlSource & "]=" & .Value
        End With
     End If
     'move all following records 'up'
     sql = "UPDATE " & sTable & " SET " & sOrder & "-1 WHERE " & Mid(sCrit, 6)
     CurrentDb.Execute sql
  Next
  'now delete the record from the table
  sql = "DELETE FROM " & sTable & " WHERE " & sKey
  CurrentDb.Execute sql
  frm.Requery
  Exit Sub
ErrHndlr:
  If Err.Number = 3061 Then
     msg = "Most likely caused by a ControlSource not being a valid field name."
  Else
     msg = "An unexpecte error occured."
  End If
  MsgBox Err.Number & " - " & Err.Description & " in ListDeleteRecordC" & _
     vbCr & msg
End Sub

Creative Commons License
ListDeleteRecord by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

Edit Discussion
Custom Search
Thank you for your support!
This page has been accessed 790 times.  This page was last modified 14:20, 23 September 2015 by azolder.   Disclaimers