[AccessD] OpenArgs

'************
'The following is clsOpenArgs (parent to clsOpenArg)
'************

Option Compare Database
Option Explicit

' BEHAVIORS:
'
'
'When a form opens, it can accept open args, a text string argument.
'The framework will check for openargs, and if they exist will check
'inside the Openagrs for arguments named the same thing as form properties.
'If such arguments are found, the framework will set the form's property
'equal to the argument value.
'
'I use this specifically to set up normal forms to be DataEntry forms
'(only allow new records to be added, not existing records edited)
'
'I decided to encapsulate this functionality in a class to make the OpenArgs
'processing cleanly defined.
'
'--------------------------------------------------------------------------
'
Private mfrm As Form     'A form reference passed in
Private mstrOpenArgs As String
Private mcolOpenArg As Collection
'.-------------------------------------------------------------------------
'THESE FUNCTIONS / SUBS ARE USED INTERNALLY TO THE CLASS
'*+ Private Init/Terminate Interface
Private Sub Class_Initialize()
    Set mcolOpenArg = New Collection
End Sub
Private Sub Class_Terminate()
    Set mcolOpenArg = Nothing
End Sub
'INITIALIZE THE CLASS
Public Sub mInit(lfrm As Form, _
                Optional blnApplyProperties As Boolean = False)
    Set mfrm = lfrm
    'The openargs string might be null
    On Error Resume Next
    mstrOpenArgs = mfrm.OpenArgs
    
    ParseOpenArgs
    '
    'The default is false, do not try and apply OpenArgs as form properties
    'If the deveopler wants to
    '
    If blnApplyProperties Then
        ApplyFrmProperties
    End If
End Sub
Public Property Get colOpenArgs() As Collection
    Set colOpenArgs = mcolOpenArg
End Property

'*+PRIVATE Class function / sub declaration

Private Function cOpenArg(strOpenArg As String) As clsOpenArg
On Error GoTo Err_cOpenArg
Dim intPosEqual As Integer
Dim strArgName As String
Dim varArgVal As Variant
Dim lclsOpenarg As clsOpenArg
    intPosEqual = InStr(strOpenArg, "=")
    If intPosEqual > 0 Then
        strArgName = Left$(strOpenArg, intPosEqual - 1)
        varArgVal = Right$(strOpenArg, Len(strOpenArg) - intPosEqual)
        Set lclsOpenarg = New clsOpenArg
        lclsOpenarg.mInit strArgName, varArgVal
        Set cOpenArg = lclsOpenarg
    End If
Exit_cOpenArg:
On Error Resume Next
Exit Function
Err_cOpenArg:
        MsgBox Err.Description, , "Error in Function clsOpenArgs.cOpenArg"
        Resume Exit_cOpenArg
    Resume 0    '.FOR TROUBLESHOOTING
End Function

Private Sub ParseOpenArgs()
On Error GoTo Err_ParseOpenArgs
Dim lstrOpenArgs As String
Dim strOpenArg As String
Dim intPos As Integer
Dim lclsOpenarg As clsOpenArg
    lstrOpenArgs = mstrOpenArgs
    intPos = InStr(lstrOpenArgs, ";")
    
    While intPos > 0
        strOpenArg = Left$(lstrOpenArgs, intPos - 1)
        Set lclsOpenarg = cOpenArg(strOpenArg)
        mcolOpenArg.Add lclsOpenarg, lclsOpenarg.pName
        lstrOpenArgs = Right$(lstrOpenArgs, Len(lstrOpenArgs) - intPos)
        intPos = InStr(lstrOpenArgs, ";")
    Wend

Exit_ParseOpenArgs:
On Error Resume Next
Exit Sub
Err_ParseOpenArgs:
        MsgBox Err.Description, , "Error in Sub clsOpenArgs.ParseOpenArgs"
        Resume Exit_ParseOpenArgs
    Resume 0    '.FOR TROUBLESHOOTING
End Sub

'
'This function cycles through all the openargs applying them to form
properties
'if an argument is named the same as a form property, and the property is
writeable
'(doesn't require being in design view to set it) then the application of
the value
'to the property will be performed and Err will not be set.  For these
OpenArgs we
'set the IsPrp to true
'
'All of this provides a way for the developer to ppass in openargs to an
opening form
'which are then used to set form properties.  It is up to the developer to
ensure that
'the property is settable, that the value they pass in is valid (correct
data type,
'correct value range etc.)
'
'In the end, the only way to know whether a passed in OpenArg is a property
is to try
'it and see.  If there is no error then the name is a property name, it is
settable in
'form view mode, and the value is acceptable.
'
Public Sub ApplyFrmProperties()
On Error GoTo Err_ApplyFrmProperties
Dim lclsOpenarg As clsOpenArg
    On Error Resume Next
    For Each lclsOpenarg In mcolOpenArg
        mfrm.Properties(lclsOpenarg.pName) = lclsOpenarg.pVal
        lclsOpenarg.pIsPrp = (Err.Number = 0)
        Err.Clear
    Next lclsOpenarg
Exit_ApplyFrmProperties:
Exit Sub
Err_ApplyFrmProperties:
        MsgBox Err.Description, , "Error in Sub
clsOpenArgs.ApplyFrmProperties"
        Resume Exit_ApplyFrmProperties
    Resume 0    '.FOR TROUBLESHOOTING
End Sub

'*-PRIVATE Class function / sub declaration
'*+PUBLIC Class function / sub declaration
Public Function mOpenArg(strArgName As String) As Variant
On Error GoTo Err_mOpenArg
    mOpenArg = mcolOpenArg(strArgName).pVal
Exit_mOpenArg:
Exit Function
Err_mOpenArg:
    Select Case Err
    Case 91
        MsgBox "mOpenArg " & strArgName & " does not exist"
        Resume Exit_mOpenArg
    Case Else
        MsgBox Err.Description, , "Error in Function clsOpenArgs.mOpenArg"
        Resume Exit_mOpenArg
    End Select
    Resume 0    '.FOR TROUBLESHOOTING
End Function '*-PUBLIC Class function / sub declaration 

The following is the code to use clsOpenArgs in a form:

Option Compare Database
Option Explicit

Dim fclsOpenArgsSimple As clsOpenArgsSimple

Private Sub Form_Open(Cancel As Integer)
    Set fclsOpenArgsSimple = New clsOpenArgsSimple
    fclsOpenArgsSimple.mInit Me, True

    Me!txtSomeMessage.Value = fclsOpenArgsSimple.mOpenArg("MsgVal")

End Sub

NOTICE that I feed in a reference to Me which is the form itself.  Thus
clsOpenArgs has a pointer to the form and can:

1) Get the openargs directly from the form.
2) Set form properties if it discovers that Openargs are supposed to be used
to set form properties.

Notice also that I set txtSomeMessage (a control on the form) with a value
passed in to the form in a OpenArg named MsgVal.  That is how you would use
the class for retrieving OpenArg values passed in.  The clsOpenArgs gets the
OpenArgs string, parses it, gets it ready to use, any you just ask for
values from the class:

fclsOpenArgsSimple.mOpenArg("SomeVarName") 

That is all there is to it.  Now you too can have an openarg class to
automatically process openargs however you might need.

BTW, I pulled the code for this from my framework and stripped out the
framework specific code from the clsOpenArgs, calling the result
clsOpenArgsSimple.

Enjoy.

John W. Colby
Colby Consulting
www.ColbyConsulting.com