ms-accessloopssubroutinesubformcontinuous-forms

Access Continuos Subform Repeating Information


Access Database Form1 is a Continuous Form that has an EmployeeID field you can double click to take you to another form that contains information about the Employee. In order to retain the correct employee I use this code...

Private Sub EmployeeID_DblClick(cancel as integer)
  Dim myID as variant 
  myID = me.EmployeeID

  DoCmd.OpenForm "frm_EmployeeInfo",,,,,,myID
End Sub

This Not only brings up the correct employee information but populates the number into a hidden textbox to retain the information.

On the Employee Form there is a TabControl with 4 tabs, one of the tabs contains a Continous subform that I am trying to populate employee information but instead of the information being populated down (let's say Employee X has 8 lines of different attributes to display) it is repeating the same one. Here is my code for the subform:

Option Compare Database

Private Sub Form_open(cancel As Integer)
  Dim strConnection, strSQL As String
  Dim conn As ADODB.Connection
  Dim tbl As ADODB.Recordset
  Dim SourceCode As String
  Dim myID As Variant

  Set conn = New ADODB.Connection
  strConnection = "ODBC;Driver={SQLserver};DSN=AccessDatabase;Server=Labor;DATABASE=Source;Trusted_Connection=Yes;"
  conn.Open strConnection

  myID = CInt(Me.OpenArgs)
  SourceCode= Nz(DLookup("[SourceCode]", "Locaton", "[LOC_ID] = Forms!frmUtility![Site].value"), "")

  If SourceCode<> "" Then
    strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
    strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
    strSQL = strSQL & SourceCode & "_EmployeesBenefitsNew WHERE EmployeeID= " & myID
  Else
    strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
    strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
    strSQL = strSQL & "EmployeesBenefitsNew WHERE EmployeeID= " & myID
  End If

  Set tbl = New ADODB.Recordset

  With tbl
    Set .ActiveConnection = conn
    .Source = strSQL
    .LockType = adLockOptimistic
    .CursorType = adOpenKeyset
    .CursorLocation = adUseClient
    .Open
  End With

  With tbl
    On Error Resume Next
      .MoveFirst
      Do Until tbl.EOF
        Me.txtBenefitID.Value = tbl!BenefitID
        Me.txtDeductionAmt.Value = tbl!DeductionAmount
        Me.txtBenefitAmt.Value = tbl!BenefitAmount
        Me.txtCoverageAmt.Value = tbl!CoverageAmount
        Me.txtEffDt.Value = tbl!EffectiveDate
        Me.txtTermDt.Value = tbl!ExpirationDate
        Set Me.Recordset = tbl
        .MoveNext

      Loop
    .Close
  End With



  conn.Close
  Set conn = Nothing
  Set tbl = Nothing

End Sub

Can anyone shed some light on this situation? Thanks!


Solution

  • You need to either set the recordset or the recordsource with the data, you cannot write to a continuous form on different lines, the lines only display as different if you have a recordset.

    So

      ''********************
         Set Me.Recordset = tbl
      ''********************
    

    In you code:

    Private Sub Form_open(cancel As Integer)
      Dim strConnection, strSQL As String
      Dim conn As ADODB.Connection
      Dim tbl As ADODB.Recordset
      Dim SourceCode As String
      Dim myID As Variant
    
      Set conn = New ADODB.Connection
      strConnection = "ODBC;Driver={SQLserver};DSN=AccessDatabase;Server=Labor;DATABASE=Source;Trusted_Connection=Yes;"
      conn.Open strConnection
    
      myID = CInt(Me.OpenArgs)
      SourceCode= Nz(DLookup("[SourceCode]", "Locaton", "[LOC_ID] = Forms!frmUtility![Site].value"), "")
    
      If SourceCode<> "" Then
        strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
        strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
        strSQL = strSQL & SourceCode & "_EmployeesBenefitsNew WHERE EmployeeID= " & myID
      Else
        strSQL = "SELECT EmployeeID,BenefitID,DeductionAmount,BenefitAmount,CoverageAmount,EffectiveDate,"
        strSQL = strSQL & "EligibleDate,ExpirationDate FROM "
        strSQL = strSQL & "EmployeesBenefitsNew WHERE EmployeeID= " & myID
      End If
    
      Set tbl = New ADODB.Recordset
    
      With tbl
        Set .ActiveConnection = conn
        .Source = strSQL
        .LockType = adLockOptimistic
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .Open
      End With
    
    
      ''********************
      Set Me.Recordset = tbl
      ''********************
    
    
      conn.Close
      Set conn = Nothing
      Set tbl = Nothing
    
    End Sub