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.execute" instead of the "rs.open", as you're using an action query to fill the table.

Nic;o)