• Status: Solved
  • Priority: Medium
  • Security: Private
  • Views: 23
  • Last Modified:

Access VBA Loop works until Compact and Repair is pressed

I used to run Compact and repair after doing some editting and changes to keep the file size down. Now all of the sudden for this particular code with some loops it causes it to give bad data after running it. To fix it all I have to do is open the application back up in debug mode (hold down the shift key) and then just close it up again and reopen. From that point on it will continue to work fine until the Compact and Repair is pressed again.

Anyone heard of this causing issues with code before or have any ideas as to why this may be happening?

Thanks for any input!

For whatever it's worth, here is the code that start returning bad values:

    Dim rs As DAO.Recordset
    Dim cRecord As Long
    Dim rCount As Long
    Dim mRecord As Long
    DoCmd.Close acForm, "frmLogon"
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM tblTEMPMRP"
    DoCmd.RunSQL "DELETE * FROM tblTEMPCompWIPQty"
    DoCmd.OpenQuery "qryInventoryShipments"
    DoCmd.OpenQuery "qryAPDCompWIPQty"
    DoCmd.SetWarnings True
    Set rs = CurrentDb.OpenRecordset("tblTEMPMRP")
    rs.MoveFirst
    rqty = 0
    
    Do Until rs.EOF
        Set rs1 = CurrentDb.OpenRecordset("SELECT tblTEMPCompWIPQty.jhPartNum, tblTEMPCompWIPQty.InvWIPQty, IssuedQty " & _
                                            "FROM tblTEMPCompWIPQty " & _
                                            "WHERE tblTEMPCompWIPQty.jhReqDueDate<= #" & rs!orReqDate & "#" & _
                                            "AND tblTEMPCompWIPQty.jhPartNum= '" & rs!odPartNum & "' AND IssuedQty = False")
        If rs1.BOF And rs1.EOF Then
            rs.Edit
            rs!InvWIPQty = 0
            rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
            rs.Update
        Else
            rs1.MoveFirst
            iwq = 0
            Do Until rs1.EOF
                If iwq = 0 Then
                    rs.Edit
                    rs!InvWIPQty = rs1!InvWIPQty
                    rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
                    rs.Update
                Else
                    rs.Edit
                    rs!InvWIPQty = rs1!InvWIPQty + iwq
                    rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
                    rs.Update
                End If
                rs1.Edit
                rs1!IssuedQty = True
                rs1.Update
                iwq = rs!InvWIPQty
                rs1.MoveNext
            Loop
        End If
        rs.MoveNext
    Loop
        
    rs.MoveLast
    rCount = rs.RecordCount
    rs.MoveFirst
    Do Until rs.EOF
        pn = rs!odPartNum
        rs.Edit
        rs!RTOnHandQty = rs!TotalQtyWIPINV
        rs.Update
        cqty = 0
        cRecord = 0
        Do Until rs!odPartNum <> pn
            If cRecord = 0 Then
                rs.Edit
                rs!RTOnHandQty = rs!RTOnHandQty - rs!RemReqQty
                rs.Update
            Else
                rs.Edit
                rs!RTOnHandQty = cqty + rs!InvWIPQty - rs!RemReqQty
                rs.Update
            End If
            If rs!RTOnHandQty < 0 Then
                rs.Edit
                rs!UnderQty = "Yes"
                rs.Update
            Else
                rs.Edit
                rs!UnderQty = "No"
                rs.Update
            End If
            cRecord = cRecord + 1
            mRecord = mRecord + 1
            cqty = rs!RTOnHandQty
            If mRecord = rCount Then
                rs.Close
                Set rs = Nothing
                rs1.Close
                Set rs1 = Nothing
                Me.Requery
                Exit Sub
            Else
                rs.MoveNext
            End If
        Loop
    Loop

Open in new window

0
Jarred Meyer
Asked:
Jarred Meyer
  • 4
  • 2
  • 2
  • +2
2 Solutions
 
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
It's hard to tell from your description, but it sounds like you have some form of DB corruption.   A compact and repair should not alter the way code runs.

I would create a fresh DB container and then import everything into it.  Make sure you do a compile to check for errors in the code or references.

Jim.
0
 
als315Commented:
How do you compacting database? With button from access or from command line?
You can create batch file, which will compact and decompile:
"c:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE" "PathToYourDB" /compact
"c:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE" "PathToYourDB" /decompile

Usual way at first decompile, then - compact, but you can try both ways
0
 
Dale FyeCommented:
No points please.  I agree with Jim, create a new DB and import everything.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Jarred MeyerProduction ManagerAuthor Commented:
Thanks yall! It could definitely be corrupted, I have to regularly decompile and would normally compact and repair at the same time. I will try and move just that module over to a new app and see what happens. I'll report back early next week
0
 
BitsqueezerCommented:
Hi,

not every time unexpected results are returned it must be a problem of a corrupted database.

It seems that you are working with temporary tables in your code which are often deleted and refilled. Maybe your code expects data in a specific order and you are surprised that the results of the calculations are not calculated "correct" because Access used another order of records.

Problem is: If you use a primary key in a table like an autonumber ID then normally you get the records back ordered by this number if you open a table directly. That's because the primary key orders the records physically in the table. A database server would do that in the background every time you add a record or change the PK value (which doesn't need to be an autonumber). Access is a file database so it doesn't do that, it only reorders the records physically whenever "Compact & Repair" is used.
But if your table has no PK there is no guaranteed order of records in the table (and to be exact: the PK is also not a guaranteed order). Every time you open the table it COULD be another order, that's called a heap in databases. The only way of being really sure that the order is the order you want is to add an "ORDER BY" at the end of your SELECT statement.

The reason is that a database wants to find it's own way of accessing the right record at the right time to find the most performant way of accessing a record. So you need any kind of key to access the right record without knowing which record is JOINed with any other at any time - you get a list of records at the end and then you can add an ORDER BY to get it in the right order.

It's usually better to let the database do the changes you want, in very many cases you don't need to use a recordset to change data. A well-formed UPDATE command would surely do the most of the things you do in your code very much better and more performant.

But also your code has some issues. The first thing you should never use is to use "CurrentDb" in a loop. This is not a reference to an object - in this case it would be OK - this is a function which creates a copy of the current workspace object which takes a lot of time when used in a loop. So create a variable "Dim db As DAO.Recordset" and set the variable "Set db = CurrentDb" at the beginning and then exchange all "CurrentDb" in your code by "db" which would let your code run a lot faster (depending on the number of records).
You also should add an "Option Explicit" at the beginning of your module (at the beginning of all modules) and then run the compiler again. I would say you would have to fix a lot of not declared variables after that at least. Don't using this option is dangerous as VBA simply creates a variable if it cannot find a declaration without this option and that is normally a Variant type.

Next is that you open the recordsets for Edit and Update that immediately - why? Not only makes your code very much longer, it is not necessary. Constructs like that:
If iwq = 0 Then
	rs.Edit
	rs!InvWIPQty = rs1!InvWIPQty
	rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
	rs.Update
Else
	rs.Edit
	rs!InvWIPQty = rs1!InvWIPQty + iwq
	rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
	rs.Update
End If

Open in new window


In both of the pathes the recordset will be edited and also the TotalQty is calculated on the samy way, so it could simply be written like that:
rs.Edit
If iwq = 0 Then
	rs!InvWIPQty = rs1!InvWIPQty
Else
	rs!InvWIPQty = rs1!InvWIPQty + iwq
End If
rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
rs.Update

Open in new window


Then, if you need to have a specific order of records in your tables you would need to add an ORDER BY to both OpenRecordset methods.

Another thing is using "Me.Requery" in the loop - that only causes reloading the complete recordset of the form which is meant in "Me", which doesn't make sense in a running loop but only as last command after the loop is completed. This costs a lot of performance in a loop. The user would not see the result as in a running loop the screen is not refreshed (until you add "DoEvents" to the loop - but don't do that here).

Next thing is "Exit Sub" inside a loop - really bad method. Although Access fortunately has methods to catch all the unclosed recordsets and connections it will do it whenever it has time to do that. If you want to exit the loop, use "Exit Do", or use an additional criterion in the loop like a "bolFinished" boolean variable which can be set in the loop to exit this and all other loops. At the end you can then close the recordsets and all other objects you no longer need. In general, you should forget "Exit Sub" and "Exit Function" except for error handling code (which is also missing here), try to use only one exit in your procedures, it is better to use a GoTo with a label in the same procedure which marks the procedure's exit as using x "Exit Sub" commands in your code where unexpected results can happen as you forgot to close some objects or other code which you intentionally wanted to run at the end of the procedure (like "Me.Requery").

In general, I can of course not say that this (using ORDER BY) is the reason for your error, it can of course also be a corrupted database file, but it's worth trying. Normally the calculations should be able to be done in one or more UPDATE/INSERT commands also which is the natural way of working with data in a database.

Cheers,

Christian
0
 
Jim Dettman (Microsoft MVP/ EE MVE)President / OwnerCommented:
<<not every time unexpected results are returned it must be a problem of a corrupted database.>>

 Excellent point Christian.

 All too often, folks in the Access world are a little to quick to jump to "corruption", when other things may be at play.

Jim.
0
 
Jarred MeyerProduction ManagerAuthor Commented:
Christian,

Thanks for all the information you provided. I'm trying to work through some of the recommendations you have made and started with this:
So create a variable "Dim db As DAO.Recordset" and set the variable "Set db = CurrentDb" at the beginning and then exchange all "CurrentDb" in your code by "db" which would let your code run a lot faster (depending on the number of records).

I added the following two lines first at the top of the code:
   Dim db As DAO.Recordset
    Set db = CurrentDb


However, I'm getting an error that highlights the Set db = CurrentDb. The error reads, "Run-time error '13': Type mismatch"


Next question:
Another thing is using "Me.Requery" in the loop - that only causes reloading the complete recordset of the form which is meant in "Me",...
This section of code I setup this way as I could not figure out how to get the loop to back out when it ran out of records. So I get the count of records using rCount = rs.RecordCount and then keep a count of the current record it is on in the loop using mRecord = mRecord + 1. At the end of each time it loops it then runs that if statement:
            If mRecord = rCount Then
                rs.Close
                Set rs = Nothing
                rs1.Close
                Set rs1 = Nothing
                Me.Requery
                MsgBox "Exit"
                Exit Sub
            Else
                rs.MoveNext
            End If

Open in new window

to see if it has run out of records, at which point the remaining code if it test true is to close recordsets and exit the sub.


If you want to exit the loop, use "Exit Do", or use an additional criterion in the loop like a "bolFinished" boolean variable which can be set in the loop to exit this and all other loops. At the end you can then close the recordsets and all other objects you no longer need

I tried changing my if statement mentioned above to use "Exit Do" but it doesn't even test true then and skips that side of the if statement completely and tries to go to the next record:
            If mRecord = rCount Then
                Exit Do
                MsgBox "Exit"
            Else
                rs.MoveNext
            End If

Open in new window


The messagebox doesn't even pop up.

My apologies for being a bit naive on most of this and I'm obviously just missing more to it but hopefully you could give me some more input on the items I've mentioned above and thanks again for all of your help!
0
 
Dale FyeCommented:
That would be:

   Dim db As DAO.Database
    Set db = CurrentDb
0
 
BitsqueezerCommented:
Hi,

Dale is of course right, sorry, my fault, it's of course Database and not Recordset.

Using Me.Requery to find out the number of records is really more bad. Usually you walk through a recordset by using a "Do While Not rs.EOF / rs.MoveNext / Loop" construct where you never need to know the number of records. You also could use DCount if you really need the number of records - but Requery is bad because Access uses LazyLoading and so the RecordCount would only return the right number of records if you use a rs.MoveLast, otherwise it can be any value.

Exit Do: As mentioned above, you cannot simply exchange Exit Sub with Exit Do here as this is an inner loop and "Exit Do" only leaves one loop, not all. This is why I said that you need to have a variable to also exit the outer loop(s) if you need to break all loops. You COULD also use a GoTo but that's not so good inside of a loop although it mostly works.

Cheers,

Christian
0
 
Jarred MeyerProduction ManagerAuthor Commented:
Ok I have the db.Database put in and that is all working fine now. As for the requery, I'm not using it to find the number of records. That is just refreshing the data on the form once the loops all finish. As for the loop finishing I still haven't been able to figure out how to stop the loop when it runs out of records other than the way it's setup at the moment.

In any case here is the latest code:
Private Sub Command45_Click()
    Dim rs As DAO.Recordset
    Dim rs1 As DAO.Recordset
    Dim cRecord As Long
    Dim rCount As Long
    Dim mRecord As Long
    Dim rQty As Long
    Dim db As DAO.Database
    Dim iwq As Long
    Dim pn As String
    Dim cQty As Long
    Set db = CurrentDb
    DoCmd.Close acForm, "frmLogon"
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE * FROM tblTEMPMRP"
    DoCmd.RunSQL "DELETE * FROM tblTEMPCompWIPQty"
    DoCmd.OpenQuery "qryInventoryShipments"
    DoCmd.OpenQuery "qryAPDCompWIPQty"
    DoCmd.SetWarnings True
    Set rs = db.OpenRecordset("SELECT * FROM tblTEMPMRP ORDER BY odPartNum,orFirmRelease DESC,orReqDate,orOrderRelNum,orOrderLine,orOrderNum")
    rs.MoveFirst
    rQty = 0
    
    Do Until rs.EOF
        Set rs1 = db.OpenRecordset("SELECT tblTEMPCompWIPQty.jhPartNum, tblTEMPCompWIPQty.InvWIPQty, IssuedQty " & _
                                            "FROM tblTEMPCompWIPQty " & _
                                            "WHERE tblTEMPCompWIPQty.jhReqDueDate<= #" & rs!orReqDate & "#" & _
                                            "AND tblTEMPCompWIPQty.jhPartNum= '" & rs!odPartNum & "' AND IssuedQty = False")
        If rs1.BOF And rs1.EOF Then
            rs.Edit
            rs!InvWIPQty = 0
            rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
            rs.Update
        Else
            rs1.MoveFirst
            iwq = 0
            Do Until rs1.EOF
                rs.Edit
                If iwq = 0 Then
                    rs!InvWIPQty = rs1!InvWIPQty
                Else
                    rs!InvWIPQty = rs1!InvWIPQty + iwq
                End If
                rs!TotalQtyWIPINV = rs!InvWIPQty + rs!OnHandQty
                rs.Update
                rs1.Edit
                rs1!IssuedQty = True
                rs1.Update
                iwq = rs!InvWIPQty
                rs1.MoveNext
            Loop
        End If
        rs.MoveNext
    Loop
        
    rs.MoveLast
    rCount = rs.RecordCount
    rs.MoveFirst
    Do Until rs.EOF
        pn = rs!odPartNum
        rs.Edit
        rs!RTOnHandQty = rs!TotalQtyWIPINV
        rs.Update
        cQty = 0
        cRecord = 0
        Do Until rs!odPartNum <> pn
            If cRecord = 0 Then
                rs.Edit
                rs!RTOnHandQty = rs!RTOnHandQty - rs!RemReqQty
                rs.Update
            Else
                rs.Edit
                rs!RTOnHandQty = cQty + rs!InvWIPQty - rs!RemReqQty
                rs.Update
            End If
            If rs!RTOnHandQty < 0 Then
                rs.Edit
                rs!UnderQty = "Yes"
                rs.Update
            Else
                rs.Edit
                rs!UnderQty = "No"
                rs.Update
            End If
            cRecord = cRecord + 1
            mRecord = mRecord + 1
            cQty = rs!RTOnHandQty
            If mRecord = rCount Then
                rs.Close
                Set rs = Nothing
                rs1.Close
                Set rs1 = Nothing
                Me.Requery
                'MsgBox "Done"
                Exit Sub
            Else
                rs.MoveNext
            End If
        Loop
    Loop
End Sub

Open in new window


Thanks again for all of your help!
0
 
Jarred MeyerProduction ManagerAuthor Commented:
Thanks for all of your help! I know I'm still not at the most efficient code at the moment but the original problem was resolved by adding in the Order By into the Sql statement in my code. Turns out that temp table was losing it's order by after compact and repair was performed and just needed to have it order it every time the code runs.

Set rs = db.OpenRecordset("SELECT * FROM tblTEMPMRP ORDER BY odPartNum,orFirmRelease DESC,orReqDate,orOrderRelNum,orOrderLine,orOrderNum")
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 4
  • 2
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now