UtterAccess HomeUtterAccess Wiki

Welcome Guest ( Log In | Register )

Custom Search
Edit Discussion
> ListInitialize    


Synopsis

Use this procedure to 'initialize' numbered/ordered lists. It is useful for sort order, priorities, or other situations when records require consecutively numbered values. It is intended to randomly order records which have not already been ordered, however it will also randomly reorder lists that have already been ordered. Related procedures are ListRenumber, ListNewRecord, ListDeleteRecord 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
' ListInitialize
' http://www.utteraccess.com/wiki/ListInitialize
' 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                    
'
'************************************************************
' Generalized Procedure to initialize list values (lists weren't previously ordered)
' 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
'     Only use to set initial list values
'     The order of the list will essentually be random
Public Sub ListInitialize(Key As String, ParamArray PairNames() As Variant)
  Dim sql As String, rst As Recordset, ctr As Long
  Dim msg As String, i As Long, sTable As String
  Dim frm As Form, sKey As String, sOrder As String, sCrit As String
On Error GoTo Hndlr
  Set frm = Application.CodeContextObject
  sTable = "[" & ListFindFormTable(frm) & "]"
  If InStr(1, sTable, "SELECT ") > 0 Then
     MsgBox "Record Source for Form " & frm.Name & " must be a table.", vbCritical
     frm.Undo
     End   'stop code execution
  End If
  'verify PairNames exist in correct numbrs
  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
  'PK same for all lists
  With frm.Controls(Key)
     sKey = "[" & .ControlSource & "]=" & .Value
  End With
  'renumber each list in order
  For i = 0 To UBound(PairNames) Step 2
     With frm.Controls(PairNames(i))
        sOrder = "[" & .ControlSource & "]"
     End With
     If Len(PairNames(i + 1)) > 0 Then
        'criteria provided, account for it
        With frm.Controls(PairNames(i + 1))
           sCrit = " WHERE [" & .ControlSource & "]=" & Nz(.Value, 0)
        End With
     End If
     sql = "SELECT " & sOrder & " FROM " & sTable & sCrit
     Set rst = CurrentDb.OpenRecordset(sql)
        With rst
           If Not .BOF Then
              .MoveFirst
              ctr = 1
              Do While Not .EOF
                 .Edit
                 .Fields(0) = ctr
                 .Update
                 ctr = ctr + 1
                 .MoveNext
              Loop
           End If
        End With
  Next
  Set rst = Nothing
  frm.Requery
  frm.Recordset.FindFirst sKey
  Exit Sub
Hndlr:
  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 ListInitialize" & _
     vbCr & msg
  Set rst = Nothing
End Sub

Creative Commons License
ListInitialize 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 719 times.  This page was last modified 14:25, 23 September 2015 by azolder.   Disclaimers