Article ID: 201025
Article Last Modified on 1/23/2007
Option Compare Database Option Explicit
Sub DupRecord()
Dim frm As Form, rs As Recordset 'Calling form
Dim ctr As Control 'controls to loop through
Dim pg As Page 'Tab's pagest to loop through
Dim strFieldName As String 'For testing Field type
Set frm = CodeContextObject 'point to calling form
Set rs = frm.RecordsetClone 'open copy of form's records
If frm.NewRecord = True Then 'already in a new record
MsgBox "This is already a new record. Nothing to duplicate.", , _
"No saved record to duplicate"
Exit Sub
End If
rs.Bookmark = frm.Bookmark 'set recordset to form's current record
DoCmd.GoToRecord acDataForm, frm.Name, acNewRec 'go to new record
For Each ctr In frm.Controls 'loop through all of the controls
If VarType(ctr.Parent) = vbObject Then 'parent is a form
Select Case ctr.ControlType 'check for data bound controls
Case acOptionButton, acCheckBox, acToggleButton, _
acOptionGroup, acBoundObjectFrame, acTextBox, _
acListBox, acComboBox
If ctr.ControlSource <> "" Then 'bound control
If InStr(1, "=[", _
Left(ctr.ControlSource, 1)) = 0 Then 'not calc'd
strFieldName = ctr.ControlSource 'get fld name
If (rs(strFieldName).Attributes _
And dbAutoIncrField) = 0 _
And (rs(strFieldName).Attributes _
And dbUpdatableField) <> 0 _
And ctr.Enabled = True _
And ctr.Locked = False Then 'ctl is updateable
ctr = rs(strFieldName) 'transfer data
End If
End If 'otherwise this is a calculated control
End If 'or an unbound control
Case acTabCtl 'This control is a Tab Control
For Each pg In ctr.Pages 'Loop through each tab
RecurseTabPage pg, rs 'Copy current record to page
Next
End Select
End If
Next
End Sub
Sub RecurseTabPage(pg As Page, rs As Recordset)
Dim ctr As Control, fsub As Form, rsub As Recordset, psub As Page
Dim strFieldName As String
For Each ctr In pg.Controls
If VarType(ctr.Parent) = vbObject Then 'isn't option group member
Select Case ctr.ControlType
Case acOptionButton, acCheckBox, acOptionGroup, _
acBoundObjectFrame, acTextBox, acListBox, acComboBox
If ctr.ControlSource <> "" Then 'bound control
If InStr(1, "=[", Left(ctr.ControlSource, 1)) _
= 0 Then 'not calculated control
strFieldName = ctr.ControlSource 'save fld name
If (rs(strFieldName).Attributes _
And dbAutoIncrField) = 0 _
And (rs(strFieldName).Attributes _
And dbUpdatableField) <> 0 _
And ctr.Enabled = True _
And ctr.Locked = False Then
ctr = rs(strFieldName)
End If
End If
End If
Case acTabCtl
'if contains other tab controls, recursively copy records
For Each psub In ctr.Pages
RecurseTabPage psub, rs
Next
End Select
End If
Next
End Sub
Command Button
--------------
Name: cmdDup
Caption: &Duplicate Record
OnClick: [Event Procedure]
Private Sub cmdDup_Click() On Error GoTo Err_cmdDup_Click ' Set a constant to the non-Tabbed form DupRecord Exit_cmdDup_Click: Exit Sub Err_cmdDup_Click: MsgBox Err.Description, , "Record failed to Duplicate" Resume Exit_cmdDup_Click End Sub
132032 ACC: How to Duplicate Main Form and Its Subform Detail Records
Additional query words: pra don t
Keywords: kbbug kbpending KB201025