VBA module crashes after 4863 rows

M

mfaqueiroz

Registered User.
Local time
Today, 14:06
Joined
Sep 30, 2015
Messages
125
Hei :)
I've a module that compares two tables:
-Table1: with all On registers
-Table2:with all Off registers
And give me the time difference between this two.
When I run this module it crashes after 4863 row.

I have put all my variables as Long, but still crashing ..any other suggestion?
:)
Thank you!

--------------------
Code:
Sub TimeBetweenOnOff()
DoCmd.SetWarnings False


Dim x, y As Long
Dim EndOn, EndOff As Long
Dim DateOn, MachineOn, DepartOn, DateOff, MachineOff, msOff, DepartOff, Difms As Long
Dim flag As Long
Dim TimeOnOff As Double




Set dbs = DBEngine(0)(0)
Set On = dbs.OpenRecordset("Table1", DB_OPEN_DYNASET) 'Query Lig já com visto e EventLogDesl
Set Off = dbs.OpenRecordset("Table2", DB_OPEN_DYNASET) 'Query Lig já com visto e EventLogDesl

EndOn = DCount("[ID]", "Table1")
EndOff = DCount("[ID]", "Table2")

x = 0
y = 0

On.MoveFirst
For x = 1 To EndOn
DateOn = On.Fields(2).Value
MachineOn = On.Fields(6).Value
msOn = On.Fields(3).Value
DepartOn = On.Fields(5).Value
Off.MoveFirst

For y = 1 To EndOff
DateOff = Off.Fields(2).Value
MachineOff = Off.Fields(6).Value
msOff = Off.Fields(3).Value
DepartOff = Off.Fields(5).Value

If MachineOn = MachineOff And DepartOn = DepartOff And DateOn < DateOff Then

If msOff > msOn Then
TimeOnOff = DateDiff("s", DateOn, DateOff)
Difms = msOff - msOn
TimeOnOff = TimeOnOff * 1000 + Difms

Off.Edit
Off.Fields(11).Value = "Sim"
Off.Update

On.Edit
On.Fields(11).Value = TimeOnOff
On.Fields(12).Value = DateOff
On.Update

flag = 1

If flag = 1 Then
y = EndOff
Else
End If

ElseIf msOff < msOn Then
TimeOnOff = DateDiff("s", DateOn, DateOff)
Difms = msOff - msOn + 1000
TimeOnOff = ((TimeOnOff - 1) * 1000) + Difms

Off.Edit
Off.Fields(11).Value = "Sim"
Off.Update

On.Edit
On.Fields(11).Value = TimeOnOff
On.Fields(12).Value = DateOff
On.Update


flag = 1

If flag = 1 Then
y = EndOff
Else
End If

End If
End If
Off.MoveNext
Next y

On.MoveNext

Next x

End Sub
 
mfaqueiroz said:
I have put all my variables as Long, but still crashing ..any other suggestion?
Click to expand...

Dim x, y As Long
Dim EndOn, EndOff As Long
Dim DateOn, MachineOn, DepartOn, DateOff, MachineOff, msOff, DepartOff, Difms As Long
Dim flag As Long
Dim TimeOnOff As Double

Not quite...

x is a variant, as well as EndOn... anything that doesn't have an "As..." next to it

Try
Dim x As Long, y As Long
Dim EndOn As Long, EndOff As Long

P.S. didn't read beyond this assuming an easy fix is an easy fix.
 
Thanks! I didn't know it.
Well my MachineOn,MachineOff,DepartOn,DepartOff are text so, i should put them as String? The DateOn/DateOff are in this format dd/mm/yyy hh:mm:ss, it is a string as well?
I've done in this way, but it stills crash.
Thank you :)
 
Code: 
Sub TimeBetweenOnOff()
    DoCmd.SetWarnings False 
    
    
    Dim x, y As Long
    Dim EndOn, EndOff As Long
    Dim DateOn, MachineOn, DepartOn, DateOff, MachineOff, msOff, DepartOff, Difms As Long
    Dim flag As Long
    Dim TimeOnOff As Double
    
    
   
    
    Set dbs = DBEngine(0)(0)
    Set On = dbs.OpenRecordset("Table1", DB_OPEN_DYNASET) 'Query Lig já com visto e EventLogDesl
    Set Off = dbs.OpenRecordset("Table2", DB_OPEN_DYNASET) 'Query Lig já com visto e EventLogDesl

    EndOn = DCount("[ID]", "Table1")
    EndOff = DCount("[ID]", "Table2")

    x = 0
    y = 0
    
        On.MoveFirst
        For x = 1 To EndOn
            DateOn = On.Fields(2).Value
            MachineOn = On.Fields(6).Value
            msOn = On.Fields(3).Value
            DepartOn = On.Fields(5).Value
            Off.MoveFirst
    
            For y = 1 To EndOff
                        DateOff = Off.Fields(2).Value
                        MachineOff = Off.Fields(6).Value
                        msOff = Off.Fields(3).Value
                        DepartOff = Off.Fields(5).Value
                        
                        If MachineOn = MachineOff And DepartOn = DepartOff And DateOn < DateOff Then
                        
                            If msOff > msOn Then
                            TimeOnOff = DateDiff("s", DateOn, DateOff)
                            Difms = msOff - msOn
                            TimeOnOff = TimeOnOff * 1000 + Difms
                            
                            Off.Edit
                            Off.Fields(11).Value = "Sim"
                            Off.Update
                            
                            On.Edit
                            On.Fields(11).Value = TimeOnOff
                            On.Fields(12).Value = DateOff
                            On.Update
                            
                            flag = 1
                            
                            If flag = 1 Then
                            y = EndOff
                            Else
                            End If
                           
                            ElseIf msOff < msOn Then
                            TimeOnOff = DateDiff("s", DateOn, DateOff)
                            Difms = msOff - msOn + 1000
                            TimeOnOff = ((TimeOnOff - 1) * 1000) + Difms
                           
                            Off.Edit
                            Off.Fields(11).Value = "Sim"
                            Off.Update
                            
                            On.Edit
                            On.Fields(11).Value = TimeOnOff
                            On.Fields(12).Value = DateOff
                            On.Update
                            
                        
                            flag = 1
                            
                            If flag = 1 Then
                            y = EndOff
                            Else
                            End If
                    
                    End If
                    End If
                     Off.MoveNext
                    Next y
                   
            On.MoveNext
            
             Next x
        
                  End Sub
My next guess would be that your On recordset only has so many rows that it has reached the EOF

Or there is no Off for the given On...

It would seem your indentation is less than perfect that would help read the code.

If you want to browse a whole recordset, usually one does it:
Code: 
Do while not rs.eof


...

    rs.movenext
loop
Can be a personaly preference

What line is it crashing on?
 
Get rid of this "DoCmd.SetWarnings False"

This stops reporting on errors which is what you want right now.

This should then report to you the cause of the problem.
 
I notice that Namliam forgot to turn warnings back on.

An all too often mistake.
 
you don't need to edit the registry:

dbengine.SetOption dbMaxLocksPerFile, 500000
 
put the code after the sub/function declaration. the effect is global and until you close your db.

access caches all locks first in memory and releases them as when you close the recordset. the limit is in the registry, but you can override them temporarily by using the above method.

another thing you might consider is manually releasing locks:

DbEngine.Idle dbFreeLocks

after each .update statement you can issue this command to ensure the changes you made to the table are flushed to disk and therefore releasing the locks.

DBEngine.Idle dbRefreshCache

refreshes memory with only the most current data from the database.

https://msdn.microsoft.com/EN-US/library/office/ff823202.aspx
 
You must log in or register to reply here.

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom