Form(screen) stops updating 1

[kennetha]

Hi all,

I have created a form which update a series of items from a for next loop in VBA.(The form contains 3 subforms).

The problem is that after a certain time the screen stops updating. Does anyone there knows what I'm doing wrong? Is it bug? Do I need to install an upgrade? Access version is 2003

Thanks in advance
Kenneth

 

[SgtJarrow]

Do you mean while the code is running the screen seems "frozen"??? Do you sometimes get that "weird white" screen or something similar?

If that is the case, it indicates to me that Access is hogging all the system resources, which is not unheard of.

To overcome this problem, look for a good spot in your code loop and execute a:

DoEvents

The help file explains a bit about DoEvents, but basically it lets the windows operating system process other events, like screen refreshes.

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[JoeAtWork]

The problem is that after a certain time the screen stops updating.

Well, you said it was a For/Next loop, so eventually it should get to the last item and stop, shouldn't it?

Otherwise, describe to us what the code is supposed to do, including the conditions for exiting the loop.

And please post the code.

 

[kennetha]

JoeAtWork,

Yes, the screen stops updating...freezes at a certain point(randomly) not always at the same point. Data is updated regularly but you don't have not to touch the keyboard or mouse, otherwise Access stops "RESPONDING".

Below please find the code as requested:

Private Sub cmdupdate_Click()

On Error GoTo Err_cmdupdate_Click

Dim x As Long, y As Long, str_chargeqty As Long

Me.txtwhat = "Updating...."

'start loop
For x = 1 To Me.txtlineto

Me.txtupdatecount = x
'
If Me.txtchargefull = True Then
str_chargeqty = Forms![s1_0Details_Grn].Form![s1_0Details_Stock]![txttotalqtyinPc]
Else
str_chargeqty = Forms![s1_0Details_Grn].Form![s1_0Details_Stock]![txtchargeqty]
End If
Me.txtchargeqty = str_chargeqty
Me.Recalc
'
If Me.txtcalcenddate = False Then

If str_chargeqty < 0.0000001 Or str_chargeqty = 0 Then
Set db = CurrentDb
Set rs = db.OpenRecordset("StorageDetailsArchive", dbOpenDynaset)
rs.AddNew
rs("billNumber") = Me.txtbillnumber
rs("fromDate") = Me.txtdatefrom
rs("toDate") = Me.txtdateto
rs("grnNumber") = Me.number
rs("grnDate") = Me.date
rs("batchCode") = Me.batchCode
rs("chargeQty") = str_chargeqty
rs.update
rs.MoveLast
rs.Close
db.Close
Forms![s1_0Details_Grn].Form![s1_0Details_BatchChange]![storageStatus] = "Settled"
Else
Set db = CurrentDb
Set rs = db.OpenRecordset("StorageDetails", dbOpenDynaset)
rs.AddNew
rs("billNumber") = Me.txtbillnumber
rs("fromDate") = Me.txtdatefrom
rs("toDate") = Me.txtdateto
rs("grnNumber") = Me.number
rs("grnDate") = Me.date
rs("batchCode") = Me.batchCode
rs("chargeQty") = str_chargeqty
rs("storageRate") = Me.storageRate
rs.update
rs.MoveLast
rs.Close
db.Close
End If
Else
Set db = CurrentDb
Set rs = db.OpenRecordset("StorageDetailsArchive1", dbOpenDynaset)
rs.AddNew
rs("billNumber") = Me.txtbillnumber
rs("fromDate") = Me.txtdatefrom
rs("toDate") = Me.txtdateto
rs("grnNumber") = Me.number
rs("grnDate") = Me.date
rs("batchCode") = Me.batchCode
rs("chargeQty") = str_chargeqty
rs.update
rs.MoveLast
rs.Close
db.Close
End If
'
'For y = 1 To 5000000: Next y 'pause a bit: tried different timming to eliminate problem..in vain
'
If x = txtlineto Then
Me.cmdclose.SetFocus
Me.cmdupdate.Enabled = False
Me.txtwhat = "Bill Updated"
cmdclose_Click
Exit For
Exit Sub
End If
DoCmd.RunCommand acCmdRecordsGoToNext

'Or
'DoCmd.SelectObject acForm, "s1_0Details_Grn"
'DoCmd.GoToRecord , "s1_0Details_Grn", acNext

Next

Exit_cmdupdate_Click:
Exit Sub

Err_cmdupdate_Click:
MsgBox Err.Description
Resume Exit_cmdupdate_Click
End Sub

Thanks in advance
Kenneth.

 

[kennetha]

How, then I can increase Access resources?

 

[SgtJarrow]

OK...couple of things I noted. I see you are opening and closing the connections to the recordsets each and everytime you use them. I recommend opening them once at the beginning of the code and closing them at the end. You just need to addnew and update lines. It also seems that this may be a lengthy process, based on your y= line. So I recommend every so often giving control back to windows, as Access tends to want to not return control over lengthy processes.

Take a look at this code. I modified your posted code based on my suggestions. You may want to change the number after the mod near the bottom of the loop to a bigger number. That really depends on how often you want to "ensure" windows gets some time to do it things...my current line says every ten records.

Private Sub cmdupdate_Click()

    On Error GoTo Err_cmdupdate_Click

    Dim x As Long, y As Long, str_chargeqty As Long

    Me.txtwhat = "Updating...."
    
    'open connections to recordsets
    Set db = CurrentDb
    Set rsStorageDetailsArchive = db.OpenRecordset("StorageDetailsArchive", dbOpenDynaset)
    Set rsStorageDetails = db.OpenRecordset("StorageDetails", dbOpenDynaset)
    Set rsStorageDetailsArchive1 = db.OpenRecordset("StorageDetailsArchive1", dbOpenDynaset)
    
    'start loop
    For x = 1 To Me.txtlineto
        Me.txtupdatecount = x
        
        If Me.txtchargefull = True Then
            str_chargeqty = Forms![s1_0Details_Grn].Form![s1_0Details_Stock]![txttotalqtyinPc]
        Else
            str_chargeqty = Forms![s1_0Details_Grn].Form![s1_0Details_Stock]![txtchargeqty]
        End If
        Me.txtchargeqty = str_chargeqty
        Me.Recalc

        If Me.txtcalcenddate = False Then
            If str_chargeqty < 0.0000001 Or str_chargeqty = 0 Then
                    rsStorageDetailsArchive.AddNew
                    rsStorageDetailsArchive("billNumber") = Me.txtbillnumber
                    rsStorageDetailsArchive("fromDate") = Me.txtdatefrom
                    rsStorageDetailsArchive("toDate") = Me.txtdateto
                    rsStorageDetailsArchive("grnNumber") = Me.Number
                    rsStorageDetailsArchive("grnDate") = Me.Date
                    rsStorageDetailsArchive("batchCode") = Me.batchCode
                    rsStorageDetailsArchive("chargeQty") = str_chargeqty
                    rsStorageDetailsArchive.Update
                    rsStorageDetailsArchive.MoveLast
                    Forms![s1_0Details_Grn].Form![s1_0Details_BatchChange]![storageStatus] = "Settled"
            Else
                    rsStorageDetails.AddNew
                    rsStorageDetails("billNumber") = Me.txtbillnumber
                    rsStorageDetails("fromDate") = Me.txtdatefrom
                    rsStorageDetails("toDate") = Me.txtdateto
                    rsStorageDetails("grnNumber") = Me.Number
                    rsStorageDetails("grnDate") = Me.Date
                    rsStorageDetails("batchCode") = Me.batchCode
                    rsStorageDetails("chargeQty") = str_chargeqty
                    rsStorageDetails("storageRate") = Me.storageRate
                    rsStorageDetails.Update
                    rsStorageDetails.MoveLast
            End If
        Else
            rsStorageDetailsArchive1.AddNew
            rsStorageDetailsArchive1("billNumber") = Me.txtbillnumber
            rsStorageDetailsArchive1("fromDate") = Me.txtdatefrom
            rsStorageDetailsArchive1("toDate") = Me.txtdateto
            rsStorageDetailsArchive1("grnNumber") = Me.Number
            rsStorageDetailsArchive1("grnDate") = Me.Date
            rsStorageDetailsArchive1("batchCode") = Me.batchCode
            rsStorageDetailsArchive1("chargeQty") = str_chargeqty
            rsStorageDetailsArchive1.Update
            rsStorageDetailsArchive1.MoveLast
        End If
        
        If x = txtlineto Then
            Me.cmdclose.SetFocus
            Me.cmdupdate.Enabled = False
            Me.txtwhat = "Bill Updated"
            cmdclose_Click
            Exit For
            Exit Sub
        End If
        
        DoCmd.RunCommand acCmdRecordsGoToNext
        
        'let windows have control again every so often to refresh and update things
        If x Mod 10 = o Then
            DoEvents
        End If
    
    Next
    
    'close the connections to the recordsets
    rsStorageDetailsArchive1.Close
    rsStorageDetails.Close
    rsStorageDetailsArchive.Close
    db.Close

Exit_cmdupdate_Click:
    Exit Sub

Err_cmdupdate_Click:
    MsgBox Err.Description
    Resume Exit_cmdupdate_Click
    
End Sub

=======================================
People think it must be fun to be a super genius, but they don't realize how hard it is to put up with all the idiots in the world. (Calvin from Calvin And Hobbs)

Robert L. Johnson III
CCNA, CCDA, MCSA, CNA, Net+, A+, CHDP
VB/Access Programmer

 

[kennetha]

Thanks for the code modification. It's neater & faster for sure.
Thanks once again
Kenneth.