Samo
07-15-2016, 12:57 AM
I got this error despite the fact i have used almost exactly the same code before and it worked perfectly well, no idea why i am getting this error saying "Operation is not allowed when the object is closed" and as you can see in the code below the object is not closed, any help please? there is no problem in the SQL code in the Setup page whatsoever. The error happens at the point "If Not rs.EOF Then"
Sub GetData()
Dim ReportBook As Workbook
Dim DataSheet As Worksheet
Dim SetupSheet1 As Worksheet
Dim SetupSheet2 As Worksheet
Dim cn As New ADODB.Connection
Dim strSql As String
Dim rs As New ADODB.Recordset
Dim strcn As String
Dim i As Integer
Set ReportBook = ThisWorkbook
Set DataSheet1 = ReportBook.Worksheets("Transaction_Table")
Set DataSheet2 = ReportBook.Worksheets("Action_Table")
Set SetupSheet = ReportBook.Worksheets("Setup")
Application.ScreenUpdating = False
DataSheet1.Range("A2:X1000").ClearContents
DataSheet2.Range("B2:V46").ClearContents
DataSheet2.Range("B48:V100").ClearContents
For i = 5 To 17
If Sheets("Setup").Cells(i, 2) = "postings" Then
strSql = strSql & SetupSheet.Cells(i, 1) & Chr(13)
End If
Next i
strcn = "Provider=******" (there is problem here i just deleted the server details)
cn.Open strcn
cn.CommandTimeout = 600
rs.Open strSql, cn
If Not rs.EOF Then
DataSheet1.Range("A2").CopyFromRecordset rs
End If
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
End Sub
The query in Excel page is:
16619
Thanks guy for your help.
Sub GetData()
Dim ReportBook As Workbook
Dim DataSheet As Worksheet
Dim SetupSheet1 As Worksheet
Dim SetupSheet2 As Worksheet
Dim cn As New ADODB.Connection
Dim strSql As String
Dim rs As New ADODB.Recordset
Dim strcn As String
Dim i As Integer
Set ReportBook = ThisWorkbook
Set DataSheet1 = ReportBook.Worksheets("Transaction_Table")
Set DataSheet2 = ReportBook.Worksheets("Action_Table")
Set SetupSheet = ReportBook.Worksheets("Setup")
Application.ScreenUpdating = False
DataSheet1.Range("A2:X1000").ClearContents
DataSheet2.Range("B2:V46").ClearContents
DataSheet2.Range("B48:V100").ClearContents
For i = 5 To 17
If Sheets("Setup").Cells(i, 2) = "postings" Then
strSql = strSql & SetupSheet.Cells(i, 1) & Chr(13)
End If
Next i
strcn = "Provider=******" (there is problem here i just deleted the server details)
cn.Open strcn
cn.CommandTimeout = 600
rs.Open strSql, cn
If Not rs.EOF Then
DataSheet1.Range("A2").CopyFromRecordset rs
End If
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
End Sub
The query in Excel page is:
16619
Thanks guy for your help.