3705 "operation is not allowed when the object is open" in vb6 + ms access

[Deepak Dahiya]

Plese help in this code , i have mentioned comment where error comes

    For iox = nMinID To nTotID
      
        On Error GoTo Hell
        
        Call Progress(iox, nTotID)
   
     
        con.Execute "delete from  ATACZ_Account_Data"
       
    'error comes in this line
        Rs.Open "insert into ATACZ_Account_Data select * from ESTMT_ATACZ_Account_Data where [supress] ='F' and [ATACZ-EMAIL] <>'' and id =" & iox, con, adOpenDynamic, adLockOptimistic
        
        Rs.Open "select * from ATACZ_Account_Data where id =" & iox, con, adOpenDynamic, adLockOptimistic
        
        Set Rs.ActiveConnection = Nothing
        
        Counter = Counter + 1
        
        DoEvents
        
        If Counter Mod 1000 = 0 Then
          
            If Len(Dir("C:\PNBApplication\Temp\*.ps")) > 0 Then
            'deepak Kill "C:\PNBApplication\Temp\*.ps"
            End If
            
            If Len(Dir("C:\PNBApplication\Temp\*.csv")) > 0 Then
                Kill "C:\PNBApplication\Temp\*.csv"
            End If
            
            If Len(Dir("C:\PNBApplication\Temp\*.pdf")) > 0 Then
                Kill "C:\PNBApplication\Temp\*.pdf"
            End If
            
            If Len(Dir("C:\PNBApplication\Temp\out*.bat")) > 0 Then
                Kill "C:\PNBApplication\Temp\out*.bat"
            End If
            Shell "taskkill /F /IM acrotray.exe", vbHide
            
        End If
        
        Label8.Caption = "Current Record :" & iox
        DoEvents
        
             
        If Not Rs.EOF Then
          
             If Check1.Value = vbUnchecked Then
            Report.DiscardSavedData
            Set crpParamDefs = Report.ParameterFields
            For Each crpParamDef In crpParamDefs
                With crpParamDef
                    Select Case UCase(Trim(.ParameterFieldName))
                        Case "ID"
                        .ClearCurrentValueAndRange
                        .AddCurrentValue CDbl(Rs.Fields("ID"))
                     End Select
                End With
            Next
            
            If OptNormal.Value = True Then Set CRXReport = CRXApp.OpenReport("C:\PNBApplication\Reports\Normal\PNB_EmailStatement_Normal.rpt")
            If OptSilver.Value = True Then Set CRXReport = CRXApp.OpenReport("C:\PNBApplication\Reports\Silver\PNB_EmailStatement_Silver.rpt")
            If OptGold.Value = True Then Set CRXReport = CRXApp.OpenReport("C:\PNBApplication\Reports\Gold\PNB_EmailStatement_Gold.rpt")
            If OptCorporate.Value = True Then Set CRXReport = CRXApp.OpenReport("C:\PNBApplication\Reports\Corporate\PNB_EmailStatement_Corporate.rpt")


            CRXReport.SelectPrinter "psscript.drv", "XeroxColor", "LPT1:"
            CRXReport.PaperOrientation = crPortrait
            CRXReport.PaperSize = crPaperA4
            End If
            
            nFileName = Format(Rs("ATACZ-DATE-CURR-STMT"), "ddMMyy") & Format(Rs("id"), "000000")
            
            If Len(Dir("C:\PNBApplication\GeneratedFiles\" & nFileName & ".pdf")) > 0 Then
                   
                LogsWriter ("Already Exists " & nFileName & ".pdf")
            Else
            
            FileCounter = FileCounter + 1
         
            
            LogsWriter ("Statement No : " & iox & " Started.")
            Filenamx2 = "C:\PNBApplication\Temp\" & Format(Rs("ATACZ-DATE-CURR-STMT"), "ddMMyy") & Format(Rs("id"), "000000")
           
            
            If Check1.Value = vbUnchecked Then
                          CRXReport.PrintOutEx False, 1, False, 1, -1, Filenamx2
            End If
            
            nAccNo = Right(Trim(CStr(Rs("ATACZ-ACCT"))), 16)
            cPwd = nAccNo
            
            nFileName = Format(Rs("ATACZ-DATE-CURR-STMT"), "ddMMyy") & Format(Rs("id"), "000000")
            Open Text4.Text & "\MIS" & Format(Now(), "ddMMyy") & ".csv" For Append As #3
            Print #3, nAccNo & "," & Rs("ATACZ-NAME-LINE-1") & "," & Rs("ATACZ-EMAIL") & "," & nFileName & ".pdf," & cPwd
            Close #3
            
            If Check1.Value = vbUnchecked Then
            Open Filenamx2 For Binary As #1
            P = String(LOF(1), vbNullChar)
            Get 1, , P
            Close #1

            Open Filenamx2 & ".ps" For Binary As #2
            Put #2, , P
            Put #2, , S
            Close #2
            
            Kill (Filenamx2)

            Open "C:\PNBApplication\Temp\out" & Rs("ID") & ".bat" For Append As #3
            Print #3, "C:\gs\gs8.14\lib\ps2pdf14.bat  -sOwnerPassword#PBXkkmmd1250 -sUserPassword#" & cPwd & " C:\PNBApplication\Temp\" & nFileName & ".ps " & Text4.Text & "\" & nFileName & ".pdf"
            'Print #3, "del C:\PNBApplication\Temp\" & nFileName & ".ps"
            Close #3
           
            RetVal = Shell("C:\PNBApplication\Temp\out" & Rs("ID") & ".bat", vbHide)
            Label9.Caption = "Generated Files :" & FileCounter
            End If
            
            '-i c:\sample.pdf -w owner -u user -e 40
            'RetVal = Shell("C:\Program Files\AdultPDF\PDFEncrypt\EncryptPDF -i C:\pnbstmt\" & nFileName & ".pdf  -w PBXkkmmd1250 -u " & cPwd & " -e 40", vbHide)
           
            LogsWriter ("Statement No :" & iox & " Completed.")
            DoEvents
                        
            End If
            End If
        
        Rs.Close
        nAccNo = ""
        cPwd = ""
        nFileName = ""
        DoEvents
        If iox > nTotID Then Exit For
                
Hell:
       If Len(Err.Description) <> 0 Then
        LogsWriter ("Error : STMT No :" & iox & Err.Description)
       End If

    Next

[Stewart Ross]

The error message is telling you that you are trying to open your recordset on a pass of your FOR-loop when it is already open, despite having a close statement somewhere near the end of the loop. Once a recordset is open you cannot (and should not) re-open it unless you close the recordset before trying to re-open it, at the end of each pass through the loop. You are also closing the active connection on each pass through the loop - which makes no sense to me.

My guess is that trying to open a recordset like this is unlikely to make sense - normally the recordset is opened BEFORE any loop processing takes place, and closed AFTER.

In addition, you have error processing code within the loop, titled somewhat unfortunately as 'Hell'. The structure of your code as it stands is not something I could recommend as good practice, being difficult to follow. I'd suggest you rewrite it, as even if you clear the errors it will still be a long code segment which has no comments to guide whoever is reading it about what it does.

At the very least, you will need to set a breakpoint so you can step and trace execution of your code line by line to determine why your Rs.Close statement is not being executed.

-Stewart

[nico5038]

I would expect a "con.execut e" instead of the "rs.open", as you're using an action query to fill the table.

Nic;o)