Run Time Errors: 3705 and 3704

[boldcode]

Hi,

I’m getting Run Time Error 3705: OPERATION IS NOT ALLOWED WHEN THE OBJECT IS OPEN when I click on a Label Button with code behind it in a MS Access Form I have. I think I found the thing causing Error 3705 within the code below which I believe has to with this variable "rstTakLists" that I created.
</SPAN>
SIDE NOTE: When I click LABEL BUTTON this is what literally happens...
1st: A message window appears that I created and all the User has to do is click on the OK button to continue
2nd: Another message window appears that I created that asks the User a question and the User has the option to click on either the Yes Button or No Button to continue

So when I click the Label button, then the OK button, and then on the No Button I get a window with Run Time Error 3705 and it highlights this VBA code ".Source = strSQLStmt" in yellow thus indicating that this is where the error is occurring. I don’t think the problem is with this VBA code ".Source = strSQLStmt", I think I am getting the Error 3705 because I need to close object “rstTakLists”. </SPAN>

I need help with closing this variable “rstTakLists” without it affecting the rest of the VBA code from executing properly. I don’t know where to place "rstTakLists.Close" without it affecting the rest of the VBA code and thus resulting in another Error of some sort.</SPAN>

Here is my code:

Dim conn       As ADODB.Connection
Dim rstTakLists  As ADODB.Recordset
Set conn = CurrentProject.Connection
Set rstTakLists = New ADODB.Recordset
 
If (totalSavings < DeltaCost) Then
ContinueFlag = True
ProgramCount = 0
With rstTakLists
        strSQLStmt = "SELECT tblTakList.TakListID As TakListID " & _
                     " FROM tblTakList" & _
                     " ORDER BY tblTakList.TakListID;"
        .Source = strSQLStmt
        .ActiveConnection = CurrentProject.Connection
        .Open Options:=adCmdTxt
    End With
    If Not (rstTakLists.EOF) Then
        rstTakLists.MoveFirst
    Else
        boolError = True
        strErrorMsg = "Error Code 3: Populating Programs Array failed, empty Recordset."
        intErrorCode = 3
        GoTo Scenario_Error
    End If
End If
rstTakLists.MoveFirst
Do While Not (rstTakLists.EOF)
    ProgramCount = ProgramCount + 1
    arrProgramCutPeople(rstTakLists!TakListID) = 0
    arrProgramCutDollars(rstTakLists!TakListID) = 0
    arrProgramCutPercentage(rstTakLists!TakListID) = 0
    rstTakLists.MoveNext
Loop

****So I added the following code after the "Loop" and it got rid of Error 3705 which was making me feel good, but then I ran a different scenario in which the User clicks on the Label Button, then clicks on the OK Button, and then clicks on the Yes Button and.........I get Run Time Error 3704: OPERATION IS NOT ALLOWED WHEN THE OBJECT IS CLOSED....

     rstTakLists.Close
     Set rstTakLists = Nothing
     Set rstTakLists = New ADODB.Recordset

.....Error 3704 points me to this part of the code:

rstTakLists.MoveFirst</SPAN>

Now I am really stuck and need some help from the forum because I don't where to go from here.

Thanks,

- BC

 

[xenou]

You only open the recordset when (totalSavings < DeltaCost). So this statement will fail if the recordset was never opened:
rstTakLists.MoveFirst (i.e., whenever totalSavings is not less than DeltaCost)

P.S.
You might need to post more of your code.

 

[boldcode]

xenu,

I think I kind of understand what you saying. Below is more of a complete version of the code that I am using. The only Run Time Error I am getting now is 3704, which again points to this (rstTakLists.MoveFirst). So taking what you said, how can I go about fixing this error?

Dim conn                                                      As ADODB.Connection
Dim rstTakLists                                             As ADODB.Recordset
Dim boolProgramCut                                     As Boolean
Dim boolError                                               As Boolean
Dim boolUserWantsProgramCuts                  As Boolean
Dim totalSavings                                           As Double
Dim DeltaCost                                               As Double
Dim arrProgramCutPeople(1 To 1000)             As Double
Dim arrProgramCutDollars(1 To 1000)             As Double
Dim arrProgramCutPercentage(1 To 1000)         As Double
Dim ContinueFlag                                            As Boolean

Set conn = CurrentProject.Connection
Set rstTakLists = New ADODB.Recordset

boolError = False
boolProgramCut = False
boolUserWantsProgramCuts = False


If Not (boolProgramCut) Then
    totalSavings = 0
    RequirementCost = 0
    boolUserWantsProgramCuts = False'/then I have more code that continues here below 

 
If (totalSavings < DeltaCost) Then
ContinueFlag = True
ProgramCount = 0

If Not (boolProgramCut) Then '/I forgot to add this line of code in my original thread
    With rstTakLists
        strSQLStmt = "SELECT tblTakList.TakListID As TakListID " & _
                     " FROM tblTakList" & _
                     " ORDER BY tblTakList.TakListID;"
        .Source = strSQLStmt
        .ActiveConnection = CurrentProject.Connection
        .Open Options:=adCmdTxt
    End With
    
If Not (rstTakLists.EOF) Then
        rstTakLists.MoveFirst
    Else
        boolError = True
        strErrorMsg = "Error Code 3: Populating Programs Array failed, empty Recordset."
        intErrorCode = 3
        GoTo Scenario_Error
    End If
End If

rstTakLists.MoveFirst

Do While Not (rstTakLists.EOF)
    ProgramCount = ProgramCount + 1
    arrProgramCutPeople(rstTakLists!TakListID) = 0
    arrProgramCutDollars(rstTakLists!TakListID) = 0
    arrProgramCutPercentage(rstTakLists!TakListID) = 0
    rstTakLists.MoveNext
Loop
     rstTakLists.Close
     Set rstTakLists = Nothing
     Set rstTakLists = New ADODB.Recordset


'/This part of the code is the mesage box with the Yes or No Button
If (totalSavings < DeltaCost) Then
    If (Not boolUserWantsProgramCuts) Then
     Response = MsgBox("Costs could not be met for this Year " & currentYear & "  by cutting AT and TC, would you like to cut programs?", vbYesNo)
     If Response = vbYes Then
         continue = True
         boolUserWantsProgramCuts = True
     Else
         continue = False
     End If
    Else
     continue = True
    End If
       
    If (continue = True) Then......'/then I have more code that continues here below

Thank you for your help,

- BC

 

[xenou]

Possibly the simplest anser is that don't need that line at all. The recordset will be at the first record when you open it. Try that!

 

[boldcode]

xenou,

I tried that but that didn't seem to do the trick.

-bc

 

[xenou]

Okay. Well nothing demonstrates why your code will fail. There are a lot of If's that make it confusing, however. I would advise a step through, line by line, to check the program (which should always be done anyway).

See tips here for debugging:
A Day in the Life: Programming: Excel VBA Debugging for Beginners

 

[boldcode]

Solved: Solution is just avery good understanding of the issues at hand

xenou,

I just wanted to thank you for your time in helping me out. I'll be closing out this thread with a better understanding of the problem at hand and will rewrite some code in an attempt to eliminate these errors.

- BC

 

[xenou]

Re: Solved: Solution is just avery good understanding of the issues at hand

No problem. Glad I could be of some help.
ξ