Operation is not allowed when object is closed

Question

This is my complete code. I was able to run the code once and get the record sets export to excel, but I can't do a different operation the second time.

It looks like after the record set is closed once, its not opening again. When I search second time it giving me the above error 3704.

Basically I have a form with three text boxes to search the database and then export the record sets to excel.

I might be missing something simple as I am not an experienced programmer.

Option Compare Database

Private Sub search_Click()

    Dim cn As Object

    Dim rs As ADODB.Recordset

    Dim strSql As String


    Dim strConnection As String

    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

    Set cn = CreateObject("ADODB.Connection")

    Set rs = New ADODB.Recordset


    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=C:\Users\e3017764\Desktop\Master.accdb"

    cn.Open strConnection


    If (skill.Value = "" And location.Value = "" And project.Value = "") Then

        MsgBox "Please Enter Atleast one criteria"


    ElseIf (skill.Value <> "" And location.Value = "" And project.Value = "") Then

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE [Primary Skills] = '" & skill.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic


    ElseIf (skill.Value = "" And location.Value = "" And project.Value <> "") Then

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE Project = '" & project.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic


    ElseIf (skill.Value = "" And location.Value <> "" And project.Value = "") Then

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE Location = '" & location.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic


    ElseIf (skill.Value <> "" And project.Value <> "" And location.Value = "") Then

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE [Primary Skills] = '" & skill.Value & "' AND Project = '" & project.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic


    ElseIf (skill.Value <> "" And project.Value = "" And location.Value <> "") Then

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE [Primary Skills] = '" & skill.Value & "' AND Location = '" & location.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic


    ElseIf (skill.Value = "" And project.Value <> "" And location.Value <> "") Then

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE Project = '" & project.Value & "' AND Location = '" & location.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic


    ElseIf (skill.Value <> "" And project.Value <> "" And location.Value <> "") Then

        rs.Open

        strSql = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE [Primary Skills] = '" & skill.Value & "' AND Project = '" & project.Value & "' AND Location = '" & location.Value & "'"

        rs.Open strSql, CurrentProject.Connection, adOpenStatic, adLockOptimistic

    End If

    MsgBox " Total Records Matched " & rs.RecordCount

    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")


    xlApp.Visible = True
    xlApp.UserControl = True

    xlWs.Cells(1, 1).Value = "E Code"
    xlWs.Cells(1, 2).Value = "Name"
    xlWs.Cells(1, 3).Value = "Project"
    xlWs.Cells(1, 4).Value = "Location"

    xlWs.Cells(2, 1).CopyFromRecordset rs

    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit


    rs.Close
    Set rs = Nothing

    cn.Close
    Set cn = Nothing

End Sub

I would change cn be an an ADODBConnection object rather than just an object. Then set the cursorlocationtype to be client. Then open the connection and see if that helps — Sam
– Sam, Commented May 5, 2015 at 13:30
You can't run the same code twice? Or different code? Which line produces the error? — Dick Kusleika
– Dick Kusleika, Commented May 5, 2015 at 13:36
Hi Sam, thanks for your reply, i just tried that but still getting the same error. its little annyoing why it works for the first time and throws error the second time. — Madhukar
– Madhukar, Commented May 5, 2015 at 13:46
hey dick, I have a form with 3 text boxes to enter the search criteria, I enter one n then click search, which perfectly gives me the result, then if I erase it and search with another criteria it thorws error. if i close the db then opn it again it works fine for the first search but second search gives me the same error. MsgBox " Total Records Matched " & rs.RecordCount that lines give me error. — Madhukar
– Madhukar, Commented May 5, 2015 at 13:49

Dick Kusleika · Accepted Answer · 2015-05-05 20:58:22Z

I agree with @Sobigen that none of your IFs are true the second time around. Maybe. Anyway, I think if you simplify the IFs, you might see the answer more quickly. Here's a rewrite to consider

Private Sub search_Click()

    Dim rs As ADODB.Recordset
    Dim sSql As String
    Dim aWhere() As String
    Dim lWhereCnt As Long
    Dim xlApp As Object
    Dim xlWs As Object

    'This never changes, so make it a constant
    Const sSELECT As String = "SELECT [Ecode/LC Code],[Resource Name],Project,Location FROM [Resource Details] WHERE "

    'put each piece of your where clause in an array
    If Len(Me.skill.Value) > 0 Then
        lWhereCnt = lWhereCnt + 1
        ReDim Preserve aWhere(1 To lWhereCnt)
        aWhere(lWhereCnt) = "[Primary Skills] = '" & Me.skill.Value & "'"
    End If

    If Len(Me.location.Value) > 0 Then
        lWhereCnt = lWhereCnt + 1
        ReDim Preserve aWhere(1 To lWhereCnt)
        aWhere(lWhereCnt) = "[Location] = '" & Me.location.Value & "'"
    End If

    If Len(Me.project.Value) > 0 Then
        lWhereCnt = lWhereCnt + 1
        ReDim Preserve aWhere(1 To lWhereCnt)
        aWhere(lWhereCnt) = "[Project] = '" & Me.project.Value & "'"
    End If

    'If there's at least one criterion
    If lWhereCnt > 0 Then

        'build the sql and execute it
        sSql = sSELECT & Join(aWhere, " And ") & ";"
        Set rs = CurrentProject.Connection.Execute(sSql)

        'if at least one record is returned put it in excel
        If Not rs.BOF And Not rs.EOF Then
            Set xlApp = CreateObject("Excel.Application")
            Set xlWs = xlApp.Workbooks.Add.worksheets(1)

            xlApp.Visible = True
            xlApp.UserControl = True

            xlWs.Cells(1, 1).Resize(1, 4).Value = Split("E Code,Name,Project,Location", ",")
            xlWs.Cells(2, 1).CopyFromRecordset rs

            xlApp.Selection.CurrentRegion.Columns.AutoFit
            xlApp.Selection.CurrentRegion.Rows.AutoFit


            rs.Close
            Set rs = Nothing
        Else
            'if no records are return, take a look at the sql statement to see why
            MsgBox sSql
        End If

    Else
        MsgBox "Please Enter Atleast one criteria"
    End If

End Sub

thank you all for help, as expected this simple fix did the trick.after each search operation i just reset all the three text boxes back to empty..now the IFs do execute and get me result everytime. I came to work today fresh this morning and was able to figure out this trick.. "fresh minds, fresh ideas" thank you all.

Collectives™ on Stack Overflow

Operation is not allowed when object is closed

1 Answer 1

1 Comment

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

1 Comment

Your Answer

Sign up or log in

Post as a guest

Related