requery not working

mcirvine

Registered User.
Local time
Today, 04:45
Joined
Dec 13, 2005
Messages
30
Hi all,

I'm new to vba and have a problem in an application I wrote. It seems that the requery is not working. I'm working with 3 resultsets. The first one contains all the records that from the original final that needs to be processed. The second one contains the distribution keys that needs to be used while processing the results from the first recordset. And the third recordset i use to update the tabel. for example when i processed the first step (i=1) then I need to refresh the recordsets to find the new data which also include the newly created records. When I execute this sometimes it works and sometimes it doesn't.

I'm new to vba so bear that in mind, any suggestions code wise are always welcome (i know it looks like spaghetti code but i'll be working on that once i get the wanted results, still struggling with the use of vba functions)




*****vba code


Private Sub Command2_Click()
On Error GoTo ErrorHandler

'Declaration of Variables
Dim maxScen As Integer 'value of last scenario id
Dim i As Integer 'counter for do loop statement, also used for current scenario
Dim sqlstmt As String 'SQL statement string
Dim Msg As String 'Error Msg, used for error handling
Dim MyDate 'contains the system date, used for reporting
Dim MyTime 'contains the system time, used for reporting
Dim FlagN As Integer 'Flag indicating which SQL statement to use, -1 = Not Like, 0 = Like
Dim addCount As Integer 'counts the number of inserts into the work_ledger table for one scenario
Dim TotalCount As Long 'counts the total number of inserts

Dim distAmount As Double

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim rs3 As ADODB.Recordset

i = 1
DoCmd.SetWarnings (No)

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\CAS\cost_accounting.mdb;"
'open a recordset
Set rs = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
Set rs3 = New ADODB.Recordset

DoCmd.SetWarnings (No)
Debug.Print i
sqlstmt = "UPDATE [CURR_SCEN_ID] SET[currScenID] = " &
DoCmd.RunSQL sqlstmt

With rs
.Open "SELECT WORK_LEDGER.REK_NR, WORK_LEDGER.CC_NR," & _
"WORK_LEDGER.SUM, WORK_LEDGER.EURO_CODE, WORK_LEDGER.PREV_CC," & _
"WORK_LEDGER.COST_TYPE, WORK_LEDGER.REVERSE_ENTRY FROM" & _
"(CURR_SCEN_ID INNER JOIN SCENARIO ON CURR_SCEN_ID.currScenID = SCENARIO.ScenId)" & _
"INNER JOIN WORK_LEDGER ON SCENARIO.CC_NR = WORK_LEDGER.CC_NR WHERE" & _
"(((WORK_LEDGER.SUM)<>0) AND ((WORK_LEDGER.REVERSE_ENTRY)=0));", cn, , , adCmdText
With rs2
.Open "SELECT DIST_KEYS.CC_ORIGIN, DIST_KEYS.REK_NR, DIST_KEYS.CC_TARGET," & _
"DIST_KEYS.PERCENT, DIST_KEYS.Not_Like FROM (CURR_SCEN_ID " & _
"INNER JOIN SCENARIO ON CURR_SCEN_ID.currScenID = SCENARIO.ScenId)" & _
"INNER JOIN DIST_KEYS ON (SCENARIO.[Rek Nr] = DIST_KEYS.REK_NR) AND " & _
"(SCENARIO.CC_NR = DIST_KEYS.CC_ORIGIN);", cn, , , adCmdText

rs3.Open "WORK_LEDGER", cn, adOpenKeyset, adLockOptimistic, adCmdTable

'Opening logfile, create file header
Open "C:\LogFile.txt" For Output As #1
Write #1, "Log File for allocation process"
Write #1,
MyDate = Date
MyTime = Time
Write #1, "Date : " & [MyDate]
Write #1, "Process started at : " & [MyTime]
Write #1,

'Get maximum number of allocation steps
maxScen = DLookup("[Max Scen]", "Max Scen Id")

Write #1, "Number of allocation steps : " & [maxScen]
Write #1,

'loop thru SQL statements for allocation
Do While i <= maxScen
Debug.Print i
sqlstmt = "Select [Not_Like] Into FlagN from [SCENARIO] where [ScenID] = " &
DoCmd.RunSQL sqlstmt
'Debug.Print Sqlstmt
FlagN = DLookup("[Not_Like]", "FlagN")
'Debug.Print FlagN
If FlagN = -1 Then 'the part with FlagN is = -1 not used yet, I might delete it for release
DoCmd.OpenQuery "Import Verdeelbedrag Not", acViewNormal, acAdd
addCount = DCount("[ScenId]", "[Berekening Verdeelbedrag Not]")
TotalCount = TotalCount + addCount
Write #1, "Number of records added for scenario " & & " = " & [addCount]
DoCmd.OpenQuery "Tegenboeking Not", acViewNormal, acAdd
Else
If FlagN = 0 Then
addCount = 1
Do While rs.EOF = False
rs2.MoveFirst
distSum = 0
Do While rs2.EOF = False
distAmount = Round(rs.Fields(2) * rs2.Fields(3), 2)
With rs3
.AddNew
.Fields("REK_NR") = rs.Fields(0)
.Fields("CC_NR") = rs2.Fields(2)
.Fields("SUM") = distAmount
.Fields("EURO_CODE") = rs.Fields(3)
.Fields("PREV_CC") = rs.Fields(1)
.Fields("COST_TYPE") = rs.Fields(5)
.Fields("REVERSE_ENTRY") = 0
.Update
End With
distSum = distSum + distAmount
addCount = addCount + 1
rs2.MoveNext
Loop
roundError = distSum - rs.Fields(2)


If roundError <> 0 Then
With rs3
.AddNew
.Fields("REK_NR") = rs.Fields(0)
.Fields("CC_NR") = "900006"
.Fields("SUM") = -roundError
.Fields("EURO_CODE") = rs.Fields(3)
.Fields("PREV_CC") = rs.Fields(1)
.Fields("COST_TYPE") = rs.Fields(5)
.Fields("REVERSE_ENTRY") = 0
.Update
End With
addCount = addCount + 1
End If

With rs3
.AddNew
.Fields("REK_NR") = rs.Fields(0)
.Fields("CC_NR") = rs.Fields(1)
.Fields("SUM") = -rs.Fields(2)
.Fields("EURO_CODE") = rs.Fields(3)
.Fields("PREV_CC") = rs.Fields(4)
.Fields("COST_TYPE") = rs.Fields(5)
.Fields("REVERSE_ENTRY") = -1
.Update
End With

Write #1, "Number of records added for scenario " & & " = " & [addCount]
TotalCount = TotalCount + addCount
rs.MoveNext
Loop
End If
End If
i = i + 1
sqlstmt = "UPDATE [CURR_SCEN_ID] SET[currScenID] = " &
DoCmd.RunSQL sqlstmt
rs.Requery
rs2.Requery
Loop
End With
End With
Write #1, "Total Number of records inserted = " & [TotalCount]
MyTime = Time
Write #1, "Process ended at : " & [MyTime]
Close #1
Exit Sub
 

Users who are viewing this thread

Back
Top Bottom