You can do it in Access. Here's some sample code that I haven't tested
yet:
Attribute VB_Name = "basFormBinding"
Option Compare Database
Option Explicit
Public Function SaveFormRecord(ByRef frm As Access.Form, ByVal
strStoredProcName As String, ByVal strRowGUID As String) As String
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim prm As ADODB.Parameter
Dim fld As ADODB.Field
Dim intParamDirection As Integer
Dim ctl As Access.Control
Dim strTag As String
On Error GoTo Proc_Err
'Get a reference to the form's underlying recordset
Set rst = frm.Recordset
'Go to the current record on the form
rst.Bookmark = frm.Bookmark
'Create a new command object as a stored proc call
Set cmd = New ADODB.Command
With cmd
.CommandType = adCmdStoredProc
.CommandText = strStoredProcName
End With
'Enumerate through form recordset fields and setup parameter definitions
and set value to the field value
For Each fld In rst.Fields
If fld.Name = strRowGUID Then
intParamDirection = adParamInputOutput
Else
intParamDirection = adParamInput
End If
With cmd
.Parameters.Append .CreateParameter("@" & fld.Name, fld.Type,
intParamDirection, fld.DefinedSize, fld.Value)
End With
Next fld
'Enumerate through the controls collection and set the parameter values
(to replace the original value set by the underlying recordset
For Each ctl In frm.Controls
strTag = ctl.Tag
If Len(strTag) > 0 Then
cmd.Parameters("@" & strTag).Value = ctl.Value
End If
Next ctl
'reference the project's current connection
Set cmd.ActiveConnection = CurrentProject.Connection
cmd.Execute , , adExecuteNoRecords
SaveFormRecord = cmd.Parameters("@" & strRowGUID).Value
Proc_Exit:
On Error Resume Next
Set rst = Nothing
Set fld = Nothing
Set cmd = Nothing
Set ctl = Nothing
Exit Function
Proc_Err:
Err.Raise Err.Number, "SaveFormRecord", Err.Description
Resume Proc_Exit
End Function
Public Sub PopulateForm(ByRef frm As Access.Form)
Dim ctl As Access.Control
Dim rst As ADODB.Recordset
Dim strTag As String
On Error GoTo Proc_Err
If Not frm.NewRecord Then
Set rst = frm.Recordset
rst.Bookmark = frm.Bookmark
For Each ctl In frm.Controls
strTag = ctl.Tag
If Len(strTag) > 0 Then
'Set value of control the the value of the field
ctl.Value = rst.Fields(strTag).Value
End If
Next
Else
For Each ctl In frm.Controls
strTag = ctl.Tag
If Len(strTag) > 0 Then
With ctl
'If there is a default value then evaluate it
If Len(.DefaultValue) > 0 Then
.Value = Eval(.DefaultValue)
Else
.Value = Null
End If
End With
End If
Next
End If
Proc_Exit:
On Error Resume Next
Set rst = Nothing
Set ctl = Nothing
Exit Sub
Proc_Err:
Err.Raise Err.Number, "PopulateForm", Err.Description
Resume Proc_Exit
End Sub
Public Sub UnbindForm(ByVal strForm As String)
Dim frm As Access.Form
Dim ctl As Access.Control
Dim fIsDataControl As Boolean
Dim strControlPrefix As String
Dim strControlSource As String
On Error GoTo Proc_Err
'Open form in design view
DoCmd.OpenForm strForm, acDesign
Set frm = Forms(strForm)
For Each ctl In frm.Controls
'Determine if the control is a data bound control and get naming prefix
Select Case ctl.ControlType
Case acTextBox
fIsDataControl = True
strControlPrefix = "txb"
Case acComboBox
fIsDataControl = True
strControlPrefix = "cbo"
Case acListBox
fIsDataControl = True
strControlPrefix = "lst"
Case acCheckBox
fIsDataControl = True
strControlPrefix = "chk"
Case acOptionButton
fIsDataControl = True
strControlPrefix = "opt"
Case acToggleButton
fIsDataControl = True
strControlPrefix = "tgl"
Case acOptionGroup
fIsDataControl = True
strControlPrefix = "fra"
Case Else
fIsDataControl = False
End Select
If fIsDataControl Then
'Get control source
strControlSource = ctl.ControlSource
If Len(strControlSource) > 0 Then
'If not a calculated control then unbind
If Left$(strControlSource, 1) <> "=" Then
With ctl
.Tag = strControlSource 'set control source to the tag
property
.ControlSource = "" 'Wipe the control source (unbind)
.Name = strControlPrefix & strControlSource 'rename the
control to convention
End With
End If
End If
End If
Next ctl
'Close and save changes
DoCmd.Close acForm, strForm, acSaveYes
Proc_Exit:
On Error Resume Next
Set ctl = Nothing
Set frm = Nothing
Exit Sub
Proc_Err:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error in
Procedure UnbindForm!"
Resume Proc_Exit
End Sub
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com
