Automating Table Save

[OldManRiver]

All,

Have a form with over 189 controls on it and trying to automate the save.

I currently use the following script to init the fields:

    On Error GoTo Err_Msg
    For Each ctl In Targetform.Controls
        ' 100 = Label, 106 = CheckBox, 109 = TextBox, 111 = ComboBox
        Select Case ctl.ControlType
            Case 106
                If ctl.Visible = True Then ctl = Null
            Case 111
                If ctl.Visible = True Then ctl = Null
            Case 109
                If ctl.Visible = True Then ctl = ""
        End Select
    Next
    Exit Sub
Err_Msg:
    MsgBox ctl.Name & " => " & "Error => " & Err.Number & " => " & Err.Description

So wanting to write something based on temp table containing 2 column Frm_Fld_Name, and Tbl_Fld_Name for assignment of form field to table field; maybe looking like this:

     Dim dbs As DAO.Database, WsP As DAO.Workspace, RsS As DAO.Recordset
    SrchNo = Targetform![cboxPSH]
    RECnum = DLookup("cad_rno", "tblCADdetail", "[cad_pjx]=" & SrchNo)
    WhrStr = "WHERE (([cad_pjx]=" & SrchNo & ") AND ([cad_rno]='" & RECnum & "'))"
    CSTstr = "SELECT * FROM tblCADdetail " & WhrStr & " ORDER BY cad_cds;"
    Set Wspace = DBEngine.Workspaces(0)
    Set dbs = CurrentDb
    Set RsS = dbs.OpenRecordset(CSTstr, dbReadOnly)
    With RsS
        If .RecordCount > 0 Then
            .MoveFirst
            .Edit
        Else
            .AddNew
        End If
   On Error GoTo Err_Msg
    For Each ctl In Targetform.Controls
        ' 100 = Label, 106 = CheckBox, 109 = TextBox, 111 = ComboBox
        Select Case ctl.ControlType
            Case 106, 109, 111
                TF_Name = DLookup("Tbl_Fld_Name","TF_Var_Def","[Frm_Fld_Name]=" & ctl.Name)
                Eval (![TF_Name] = ctl)
        End Select
    Next
        .Update
        .Close
    End With
    Exit Sub
Err_Msg:
    MsgBox ctl.Name & " => " & "Error => " & Err.Number & " => " & Err.Description

So I do not have to run documenter and cut/paste all vars into the save subroutine.

Is my idea solid and what are the pit falls?

OMR

 

[OldManRiver]

Quick Table Redesign

All,

Got to thinking about this for total code re-usability and decided to create the table as:

tblF2Tmatch:
tfl_id autoincrement
tfl_frm text (Form Name)
tfl_ffd text (Form Field Name)
tfl_tbl text (Table Name)
tfl_tfd text (Table Field Name)
tfl_spc y/n (Special Processing)
tfl_fnc text (SP Function Name)
tfl_prm text (SPF Parms)

where I can map any field on any form to any field in any table and then create var assignments for fields needing special processing and/or something other than direct var to var connection to table fields.

Thinking on function call something like var = func_nam(form_fld,parmlist)

so var get assigned directly in my process to the table field, like I was orgininally thinking

Oh, those of you who have not done complete multi-user mode and are stuck in the "relationship" mode, sorry VBA like this solves those problems.

OMR

 

[OldManRiver]

Main Issue

All,

My main issue is with the evaluation or interpretation of the names from the table I created. If I am remembering correctly, VBA has four different way to interpret and execute a command string and it varies depending on which var type you have.

What I usually struggle with is getting the second of the following 2 lines right:

          TF_Name = DLookup("tfl_nam", "tblTFmatch", "[tfl_fnm]=" & ctl.Name)
          Eval (![TF_Name] = ctl)

On the note about DLookup, I could open this table in a recordset, write it to an array and then process out of an array, if speed is an issue.

OMR

 

[OldManRiver]

Testing

All,

Think I have my code right:

Sub Sav_Rec()
    Dim dbs As DAO.Database, WsP As DAO.Workspace, RsS As DAO.Recordset, Ffld As Field
    Dim Fnc_Nam, Fnc_Pms, RECnum, SrchNo, SQLstr, TF_Name, WhrStr, Tfld As Field
    SrchNo = Targetform![cboxPSH]
    Set Wspace = DBEngine.Workspaces(0)
    Set dbs = CurrentDb
    DoCmd.Hourglass True
    On Error GoTo Err_Msg
    For Each Ffld In Targetform.Fields
        TF_Name = DLookup("tfl_nam", "tblTFmatch", "[tfl_fnm]=" & Ffld.Name)
        If (Ffld.Name <> Ffld.Value) Or Not (IsNull(Ffld.Name) = IsNull(Ffld.Value)) Then
            RECnum = DLookup("cad_rno", "tblCADdetail", "[cad_pjx]=" & SrchNo)
            WhrStr = "WHERE (([cad_pjx]=" & SrchNo & ") AND ([cad_rno]='" & RECnum & "'))"
            SQLstr = "SELECT * FROM tblCADdetail " & WhrStr & " ORDER BY cad_cds;"
            Set RsS = dbs.OpenRecordset(SQLstr, dbOpenDynaset)
            With RsS
                If .RecordCount > 0 Then
                    .MoveFirst
                    .Edit
                Else
                    .AddNew
                End If
                On Error Resume Next
                TF_Name = DLookup("tfl_tfd", "tblTFmatch", "[tfl_ffd]=" & Ffld.Name)
                Fnc_Nam = DLookup("tfl_fnc", "tblTFmatch", "[tfl_ffd]=" & Ffld.Name)
                Fnc_Pms = DLookup("tfl_prm", "tblTFmatch", "[tfl_ffd]=" & Ffld.Name)
                On Error GoTo Err_Msg
                For Each Tfld In .Fields
                    If TF_Name = Tfld.Name Then
                        If IsNull(Fnc_Nam) Or Fnc_Nam = "" Then
                            Tfld = Ffld.Value
                        Else
                            Tfld = Fnc_Nam(Ffld.Name, Ffld.Value, Fnc_Pms)
                        End If
                    End If
                Next
                .Update
                .Close
            End With
        End If
    Next
    DoEvents
    DoCmd.Hourglass False
    Exit Sub
Err_Msg:
    MsgBox ctl.Name & " => " & "Error => " & Err.Number & " => " & Err.Description
    Resume Next
End Sub

Now testing

OMR

 

[DCrake]

    For Each Ffld In Targetform.Fields
      [B]  TF_Name = DLookup("tfl_nam", "tblTFmatch", "[tfl_fnm]=" & Ffld.Name)[/B]
        If (Ffld.Name <> Ffld.Value) Or Not (IsNull(Ffld.Name) = IsNull(Ffld.Value)) Then
            RECnum = DLookup("cad_rno", "tblCADdetail", "[cad_pjx]=" & SrchNo)
            WhrStr = "WHERE (([cad_pjx]=" & SrchNo & ") AND ([cad_rno]='" & RECnum & "'))"
            SQLstr = "SELECT * FROM tblCADdetail " & WhrStr & " ORDER BY cad_cds;"
            Set RsS = dbs.OpenRecordset(SQLstr, dbOpenDynaset)
            With RsS
                If .RecordCount > 0 Then
                    .MoveFirst
                    .Edit
                Else
                    .AddNew
                End If
                On Error Resume Next
[COLOR="Red"]                [B]TF_Name = DLookup("tfl_tfd", "tblTFmatch", "[tfl_ffd]=" & Ffld.Name)[/B]                
                Fnc_Nam = DLookup("tfl_fnc", "tblTFmatch", "[tfl_ffd]=" & Ffld.Name)
                Fnc_Pms = DLookup("tfl_prm", "tblTFmatch", "[tfl_ffd]=" & Ffld.Name)[/COLOR]
                On Error GoTo Err_Msg
                For Each Tfld In .Fields
                    If TF_Name = Tfld.Name Then
                        If IsNull(Fnc_Nam) Or Fnc_Nam = "" Then
                            Tfld = Ffld.Value
                        Else
                            Tfld = Fnc_Nam(Ffld.Name, Ffld.Value, Fnc_Pms)
                        End If
                    End If
                Next
                .Update
                .Close
            End With
        End If
    Next

Comments:

You are performing the same lookup twice

You are performing 3 lookups on the same table for every control on the form.

Would it not be better to use a recordset to grab the whole record as one read/write exercise and pass the results to the vars in one go

Dim RsTmp as DAO.RecordSet
  Set RsTmp = CurrentDb.OpenRecordset("Select * From tblTFmatch Where tfl_ffd = '" & Ffld.Name & "'")

If Not RsTmp.EOF And Not RsTmp.BOF Then
   TF_Name = RsTmp("tfl_tfd")
   Fnc_Nam = RsTmp("tfl_fnc")
   Fnc_Pms = RsTmp("tfl_prm")
   RsTmp.Close
End If
Set RsTmp = Nothing

 

[OldManRiver]

Could be a recordset would be better, but already have two loops working so wanted to not complicate things.

OMR

 

[OldManRiver]

Still Stumped

All,

Still stuck trying to get the eval/interpret on the call of a function name to work.

Yeah replaced the Dlookups with recordset, and some redesign on the table including a column for datatype, but program runs up to the point of trying to run the function, by name and will not run because of how VB does variable interpretation.

OMR

 

[DCrake]

How are you calling your function? some actual code may help

X = FunctionName()

If FunctionName() = ?? Then

Call FunctionName()

Variations of calling a function, the method is determined by what the function is is doing.

David

 

[gemma-the-husky]

i'm lost - i dont realy understand why you are saving 189 controls on a form

do you mean this is an unbound form, or is this something else?


IGNORE THIS

I made similar comments on your other thread - but I STILL dont get what you are trying to achieve.

 

[OldManRiver]

i'm lost - i dont realy understand why you are saving 189 controls on a form

do you mean this is an unbound form, or is this something else?

G,

Yes I do not design anything for single user, so always design every form as totally unbound, even the combo boxes with .rowsource are unbound and queries to propogate are in the VBA class modules.

OMR

 

[OldManRiver]

How are you calling your function? some actual code may help

X = FunctionName()

If FunctionName() = ?? Then

Call FunctionName()

Variations of calling a function, the method is determined by what the function is is doing.

David

I'm calling by interpreting a string, which is the problem, the string is refusing to interpret, but I know it will, if the syntax/calls are right.

OMR

 

[OldManRiver]

Explaination

All,

Think maybe I'm not explaining the problem right.

The line in hard code would be:

Call RoutineName(1stParm, 2ndParm, ...)
or
Someval = FunctionName(1stParm, 2ndParm, ...)

When I'm using the term "interpret" that means I'm constructing a string, assuming the parms are also vars, as coming from query, with:

I_line = RoutineName & "(" & 1stParm & ", " & 2ndParm & "," & ...)

then the line is to execute with:

Call Eval(I_line)
or
Someval = Eval(I_line)

So the substitution for the vars happens and the actual funciton/routine is executed, but never a HARD CODE CALL to the function/routine.

I can do this easily in most languages I program in but really struggling here as VB/VBA does not like to both interpret and then execute the interpreted string.

Some help would be appreciated.

Thanks!

OMR

 

[OldManRiver]

Idea

All,

Was talking with another guru on another source and he suggested that what I'm trying to do has reached one of the limitation within the VB/VBA system.

Not sure about that so thought I'd ask y'all.

If I have, I have one idea that may get me around this. I really hack a lot in REXX, so already have a module with a partial set of the REXX commands as functions. REXX uses the "Interpret" function to do what "Eval" is supposed to do, so thinking if I write the "Interpret" fuction for my REXX module, and even if it takes 500-1500 lines of code, get this working so it seamlessly calls either routine or function from stringed command using this function, I think it would be worth it especially if the automation is re-usable.

What do y'all think? Would you do it? Are you interested in where I get?

OMR