Эксплуатация не допускается, когда объект закрыт.

Question

Это мой полный код. Мне удалось запустить код один раз и получить экспорт наборов записей в excel, но я не могу выполнить другую операцию во второй раз.

Похоже, что после того, как набор записей закрыт один раз, его снова не открывается. Когда я вторгаю второй раз, он дает мне вышеуказанную ошибку .

В принципе у меня есть форма с тремя текстовыми полями для поиска в базе данных, а затем для экспорта наборов записей в Excel.

Возможно, мне не хватает чего-то простого, так как я не опытный программист.

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 

Answer 1

Я согласен с @Sobigen, что ни один из ваших IF не верен во второй раз. Может быть. Во всяком случае, я думаю, что если вы упростите IF, вы можете увидеть ответ быстрее. Вот пересмотр для рассмотрения

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