Access VBA

Excel VBA
Excel Formulas
User-defined Functions
Office Links
Access VBA
Access SQL
Alan’s Excel FAQ
Excel Home
Alan’s Home

Three Nested Recordsets

Had an occasion to read from one table and get the account number, go to another table on our DB2 to get the account information, and finally write the info to a third table.
Function fnGetsetSetAmts()
   ' On Error GoTo ErrorHandler
   On Error Resume Next
    Dim DB      As Database
    Dim RST     As Recordset
    Dim strSQL  As String
    Dim strSet  As String
    Dim X       As Long
    Dim rsSet   As Recordset
    Dim RSwrite As Recordset
    Dim Z       As Integer
    Dim varStatus   As Variant
    Dim strStatus   As String
    varStatus = SysCmd(acSysCmdClearStatus)	'Clear any Status showing
    SysCmd acSysCmdInitMeter, "Updating: ", 5263	'Init Status meter
    DoCmd.RunSQL "DELETE tblSetsetBalances.* FROM tblSetsetBalances;"	'Zap rows from file to fill
    Z = 0
    X = 0
    Set DB = CurrentDb
   Set RST = DB.OpenRecordset("Distinct_OffSets", dbOpenDynaset)
'   RST.MoveLast
'    X = RST.RecordCount
    Set RSwrite = DB.OpenRecordset("tblSetsetBalances", dbOpenDynaset)

    RST.MoveFirst
    Do Until RST.EOF
        strSQL = "SELECT DB2_BAL.ACCT_NUM, DB2_BAL.ACCUM_AMT, " _
            & "DB2_BAL.CSH_AVAIL_AMT, DB2_BAL.EQUITY_AMT, " _
            & "DB2_BAL.PCT, DB2_BAL.MAIN_AMT "
        strSQL = strSQL & vbCrLf & " FROM DB2_BAL"
        strSQL = strSQL & " WHERE DB2_BAL.ACCT_NUM =" & RST!Setsets & ";"
    
        Set rsSet = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)	'Read data from
    '    Debug.Print RST!Setsets & Chr(32) & Z
        If rsSet!ACCT_NUM = vbNullString Then GoTo BlankRecord   'If no records returned, drop out
        RSwrite.AddNew        'Fills with current Inv Acct #s
        X = X + 1
            RSwrite!SetsetAcct = rsSet!ACCT_NUM
            RSwrite!T1 = rsSet!CSH_AVAIL_AMT
            RSwrite!AFC  = rsSet!ACCUM_AMT
            RSwrite![CALL] = rsSet!MAIN_AMT
            RSwrite![EQTY%] = rsSet!PCT * 100
            RSwrite!ReportDate = Now()
        RSwrite.Update
BlankRecord:
        RST.MoveNext
        strStatus = FormatNumber((Z / 5264) * 100, 3) & "%   " & X
       varStatus = Application.SysCmd(acSysCmdInitMeter, strStatus, Z)
        Z = Z + 1
        
        DoEvents
    Loop
    Set RST = Nothing
    Set rsSet = Nothing
    Set RSwrite = Nothing
    MsgBox "Done"
    varStatus = SysCmd(acSysCmdClearStatus)
    Exit Function
ErrorHandler:
    MsgBox Err.Number & " was reported " & vbCrLf & Err.Description, vbCritical
    varStatus = SysCmd(acSysCmdClearStatus)
End Function


The Status Bar is not working completely right.

© MMX

Updated:  05/27/2010 19:26
This page added:  13 May 2010