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.
|