By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,836 Members | 1,876 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,836 IT Pros & Developers. It's quick & easy.

Can't get Allen Browne's Carry Over records code to work in a form and subform

P: 1
I have a form that also contains a subform. I have tried to input Allen Browne's code to have the last records entered on the form to carry over when a new record is added. However, nothing is carrying over. Here is my code.

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3. Public Function CarryOver(frm As Form, strErrMsg As String, ParamArray avarExceptionList()) As Long
  4. On Error GoTo Err_Handler
  5.     'Purpose: Carry over the same fields to a new record, based on the last record in the form.
  6.     'Arguments: frm               = the form to copy the values on.
  7.     '           strErrMsg         = string to append error messages to.
  8.     '           avarExceptionList = list of control names NOT to copy values over to.
  9.     'Return:    Count of controls that had a value assigned.
  10.     'Usage:     In a form's BeforeInsert event, excluding Surname and City controls:
  11.     '               Call CarryOver(Me, strMsg, "Surname", City")
  12.     Dim rs As DAO.Recordset         'Clone of form.
  13.     Dim ctl As Control              'Each control on form.
  14.     Dim strForm As String           'Name of form (for error handler.)
  15.     Dim strControl As String        'Each control in the loop
  16.     Dim strActiveControl As String  'Name of the active control. Don't assign this as user is typing in it.
  17.     Dim strControlSource As String  'ControlSource property.
  18.     Dim lngI As Long                'Loop counter.
  19.     Dim lngLBound As Long           'Lower bound of exception list array.
  20.     Dim lngUBound As Long           'Upper bound of exception list array.
  21.     Dim bCancel As Boolean          'Flag to cancel this operation.
  22.     Dim bSkip As Boolean            'Flag to skip one control.
  23.     Dim lngKt As Long               'Count of controls assigned.
  24.  
  25.     'Initialize.
  26.     strForm = frm.Name
  27.     strActiveControl = frm.ActiveControl.Name
  28.     lngLBound = LBound(avarExceptionList)
  29.     lngUBound = UBound(avarExceptionList)
  30.  
  31.     'Must not assign values to the form's controls if it is not at a new record.
  32.     If Not frm.NewRecord Then
  33.         bCancel = True
  34.         strErrMsg = strErrMsg & "Cannot carry values over. Form '" & strForm & "' is not at a new record." & vbCrLf
  35.     End If
  36.     'Find the record to copy, checking there is one.
  37.     If Not bCancel Then
  38.         Set rs = frm.RecordsetClone
  39.         If rs.RecordCount <= 0& Then
  40.             bCancel = True
  41.             strErrMsg = strErrMsg & "Cannot carry values over. Form '" & strForm & "' has no recrods." & vbCrLf
  42.         End If
  43.     End If
  44.  
  45.     If Not bCancel Then
  46.         'The last record in the form is the one to copy.
  47.         rs.MoveLast
  48.         'Loop the controls.
  49.         For Each ctl In frm.Controls
  50.             bSkip = False
  51.             strControl = ctl.Name
  52.             'Ignore the active control, those without a ControlSource, and those in the exception list.
  53.             If (strControl <> strActiveControl) And HasProperty(ctl, "ControlSource") Then
  54.                 For lngI = lngLBound To lngUBound
  55.                     If avarExceptionList(lngI) = strControl Then
  56.                         bSkip = True
  57.                         Exit For
  58.                     End If
  59.                 Next
  60.                 If Not bSkip Then
  61.                     'Examine what this control is bound to. Ignore unbound, or bound to an expression.
  62.                     strControlSource = ctl.ControlSource
  63.                     If (strControlSource <> vbNullString) And Not (strControlSource Like "=*") Then
  64.                         'Ignore calculated fields (no SourceTable), autonumber fields, and null values.
  65.                         With rs(strControlSource)
  66.                             If (.SourceTable <> vbNullString) And ((.Attributes And dbAutoIncrField) = 0&) _
  67.                                 And Not (IsCalcTableField(rs(strControlSource)) Or IsNull(.Value)) Then
  68.                                 If ctl.Value = .Value Then
  69.                                     'do nothing. (Skipping this can cause Error 3331.)
  70.                                 Else
  71.                                     ctl.Value = .Value
  72.                                     lngKt = lngKt + 1&
  73.                                 End If
  74.                             End If
  75.                         End With
  76.                     End If
  77.                 End If
  78.             End If
  79.         Next
  80.     End If
  81.  
  82.     CarryOver = lngKt
  83.  
  84. Exit_Handler:
  85.     Set rs = Nothing
  86.     Exit Function
  87.  
  88. Err_Handler:
  89.     strErrMsg = strErrMsg & Err.Description & vbCrLf
  90.     Resume Exit_Handler
  91. End Function
  92.  
  93. Private Function IsCalcTableField(fld As DAO.Field) As Boolean
  94.     'Purpose: Returns True if fld is a calculated field (Access 2010 and later only.)
  95. On Error GoTo ExitHandler
  96.     Dim strExpr As String
  97.  
  98.     strExpr = fld.Properties("Expression")
  99.     If strExpr <> vbNullString Then
  100.         IsCalcTableField = True
  101.     End If
  102.  
  103. ExitHandler:
  104. End Function
  105.  
  106. Public Function HasProperty(obj As Object, strPropName As String) As Boolean
  107.     'Purpose: Return true if the object has the property.
  108.     Dim varDummy As Variant
  109.  
  110.     On Error Resume Next
  111.     varDummy = obj.Properties(strPropName)
  112.     HasProperty = (Err.Number = 0)
  113. End Function
Aug 3 '10 #1
Share this question for a faster answer!
Share on Google+

Post your reply

Sign in to post your reply or Sign up for a free account.