Duplicate record not working access 2003

On Error GoTo Err_Command20_Click
 
 
    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70 'Paste Append
 
DocumentName.Value = Null
Text9.Value = Null
 
Exit_Command20_Click:
    Exit Sub
 
Err_Command20_Click:
    MsgBox Err.Description
    Resume Exit_Command20_Click

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:

Simple version -- OK if there is no AutoNumber or other key field in the record source
 
   DoCmd.RunCommand acCmdSelectRecord
   DoCmd.RunCommand acCmdCopy
   DoCmd.RunCommand acCmdPasteAppend
 
This one works with any record source -- put "No Copy" in the Tag property of the controls whose values should not be copied.
 
It is called from a command button on a form, like this:
 
   Call CopyRecord(Me)
 
Public Sub CopyRecord(frm As Access.Form)
'Created by Helen Feddema 26-Sep-2009
'Last modified 26-Sep-2009
 
On Error GoTo ErrorHandler
 
   Dim CopyFields() As Variant
   
   lngCount = CountControls(frm)
   Debug.Print "Number of controls to copy: " & lngCount
   
   'Redimension array with actual number of controls to copy
   ReDim CopyFields(lngCount - 1, 1)
   
   'Cycle through all controls on form Detail section (except those
   'marked "No Copy") and save to an array
   lngCount = 0
   lngArrayNo = 0
   
   For Each ctl In frm.Section(acDetail).Controls
      strControlName = ctl.Name
      Debug.Print "Control name: " & strControlName _
         & "; tag: " & ctl.Tag
         
      If InStr(ctl.Tag, "No Copy") = 0 Then
      
         'Check field type and skip those that don't have values
         Debug.Print "Control name: " & strControlName
         lngControlType = ctl.ControlType
         
         Select Case lngControlType
            'Controls with values
            Case acTextBox
               Debug.Print "Control source: " & ctl.ControlSource
               GoTo Copy
            
            Case acComboBox
               GoTo Copy
            
            Case acCheckBox
               GoTo Copy
            
            Case acBoundObjectFrame
               GoTo Copy
               
            Case acListBox
               GoTo Copy
           
            Case acOptionGroup
               GoTo Copy
            
            Case acOptionButton
               'Check for control source, and only copy from
               'option buttons with one (bound option buttons)
               strTest = ctl.ControlSource
               GoTo Copy
               
            Case Else
               'No Value property; nothing to copy
               GoTo NoCopy
         End Select
Copy:
         strFieldName = ctl.ControlSource
         varFieldValue = ctl.Value
         Debug.Print strFieldName & " value: " & varFieldValue
         CopyFields(lngArrayNo, 0) = strFieldName
         CopyFields(lngArrayNo, 1) = varFieldValue
         lngArrayNo = lngArrayNo + 1
         lngCount = lngCount + 1
NoCopy:
      End If
   Next ctl
 
   Debug.Print "Number of controls to copy: " & lngCount
   
   'Create recordset, add a new record, and copy data to it from array
   Set dbs = CurrentDb
   strTable = "Pharmacy Scheduling"
   
   Set rst = dbs.OpenRecordset(strTable, dbOpenDynaset)
   With rst
      .AddNew
      For lngArrayCount = 0 To lngCount - 1
         Debug.Print "Processing row " & lngArrayCount
         strFieldName = CopyFields(lngArrayCount, 0)
         varFieldValue = CopyFields(lngArrayCount, 1)
         Debug.Print "Field name: " & strFieldName
         Debug.Print "Field value: " & varFieldValue
         If strFieldName <> "" Then
            .Fields(strFieldName) = varFieldValue
         End If
      Next lngArrayCount
      .Update
      .Close
   End With
      
   'Requery form and go to new record
   frm.Requery
   DoCmd.GoToRecord objecttype:=acDataForm, _
      objectname:=frm.Name, _
      record:=acLast
   
ErrorHandlerExit:
   Exit Sub
 
ErrorHandler:
   If Err.Number = 2455 Then
      'Unbound option button
      Resume NoCopy
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " & _
         Err.Description
      Resume ErrorHandlerExit
   End If
 
End Sub
 
Public Function CountControls(frm As Access.Form) As Long
'Created by Helen Feddema 26-Sep-2009
'Last modified 26-Sep-2009
 
On Error GoTo ErrorHandler
   
   'Cycle through all controls on form Detail section (except those
   'marked "No Copy") and determine number of controls to copy
   lngCount = 0
   strTest = ""
   
   For Each ctl In frm.Section(acDetail).Controls
      strControlName = ctl.Name
      'Debug.Print "Control name: " & strControlName
      
      If InStr(ctl.Tag, "No Copy") = 0 Then
      
         'Check field type and skip those that don't have values
         lngControlType = ctl.ControlType
         
         Select Case lngControlType
            'Controls with values
            Case acTextBox
               GoTo CountCtl
            
            Case acComboBox
               GoTo CountCtl
            
            Case acCheckBox
               GoTo CountCtl
            
            Case acBoundObjectFrame
               GoTo CountCtl
               
            Case acListBox
               GoTo CountCtl
           
            Case acOptionGroup
               GoTo CountCtl
            
            Case acOptionButton
               'Check for control source, and only count
               'option buttons with one (bound option buttons)
               strTest = ctl.ControlSource
               If strTest <> "" Then
                  GoTo CountCtl
               End If
               
            Case Else
               'No Value property; don't count
               GoTo NoCount
         End Select
         
CountCtl:
         lngCount = lngCount + 1
NoCount:
      End If
   
      strTest = ""
   Next ctl
 
   Debug.Print "Number of controls to copy: " & lngCount
   CountControls = lngCount
   
ErrorHandlerExit:
   Exit Function
 
ErrorHandler:
   If Err.Number = 2455 Then
      'Unbound option button
      Resume NoCount
   Else
      MsgBox "Error No: " & Err.Number & "; Description: " & _
         Err.Description
      Resume ErrorHandlerExit
   End If
 
End Function
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:

Public Function fm_CloneRecord( _
    frm As Form, _
    ParamArray SkipFields() _
  ) As Boolean
Dim rsCurrent As DAO.Recordset
Dim fld As DAO.Field
Dim i As Integer
On Error GoTo ProcErr
  ' save current record if necessary
  If frm.Dirty Then frm.Dirty = False
  Set rsCurrent = frm.RecordsetClone
  rsCurrent.Bookmark = frm.Bookmark
  frm.Recordset.AddNew
  For Each fld In rsCurrent.Fields
    ' skip if AutoNumber
    If (fld.Attributes And dbAutoIncrField) <> 0 Then GoTo NextField
    ' skip if not Updatable
    If (fld.Attributes And dbUpdatableField) = 0 Then GoTo NextField
    ' skip if in out skip list
    For i = 0 To UBound(SkipFields)
      If fld.Name = SkipFields(i) Then GoTo NextField
    Next
    frm(fld.Name) = fld
NextField:
  Next fld
  fm_CloneRecord = True
ProcEnd:
  On Error Resume Next
  Exit Function
ProcErr:
  MsgBox "Error #" & Err.Number & " cloning record" _
    & vbCrLf & vbCrLf & Err.Description
  Resume ProcEnd
End Function

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34: