J
Jez
Hi, Please help...
This is my query below trying to extract data from Access into Excel. I am
having trouble withthe second part of the query. It works fine to bring in
the first SQL but then fails on the second and gives me this error message
"Operation is not allowed when the object is open"
I dont understand why its going wrong when I havent closed the connection
between the database but only closed when created the recordset.. How can I
fix this problem, as I may want to add another SQL to it?
Option Explicit
Dim cnnDW As ADODB.Connection
Dim rsDW As ADODB.Recordset
Dim sQRY As String
Dim strDWFilePath, strCSVFilePath, strDestFilePath, strDestFileName As String
Sub GetData()
On Error GoTo Err:
strDWFilePath = "H:\NCHO\Housing Services\Data Warehouse\HSG Data
Warehouse.mdb"
Set cnnDW = New ADODB.Connection
Set rsDW = New ADODB.Recordset
'ASV N Week by Contract
Sheet4.Range("B5:BB23").ClearContents
cnnDW.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDWFilePath & ";"
sQRY = "TRANSFORM Count([qryNoAccess(byAppt)].WRNumber) AS
CountOfWRNumber " & _
"SELECT [qryNoAccess(byAppt)].CouncilName " & _
"FROM [qryNoAccess(byAppt)] " & _
"WHERE ((([qryNoAccess(byAppt)].BANumber) <> 'HSG0008 20') And
(([qryNoAccess(byAppt)].AppointmentOutcomeID) = 'N') And
(([qryNoAccess(byAppt)].ActionTypeID) = 'AS')) " & _
"GROUP BY [qryNoAccess(byAppt)].CouncilName " & _
"PIVOT [qryNoAccess(byAppt)].Week"
rsDW.CursorLocation = adUseClient
rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet4.Range("B5").CopyFromRecordset rsDW
rsDW.Close
Set rsDW = Nothing
Set rsDW = New ADODB.Recordset
'ASV N Week by Neigbourhood
Sheet4.Range("B25:BB79").ClearContents
cnnDW.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDWFilePath & ";"
sQRY = "TRANSFORM Count([qryNoAccess(byAppt)].WRNumber) AS
CountOfWRNumber " & _
"SELECT [qryNoAccess(byAppt)].CouncilDistrict " & _
"FROM [qryNoAccess(byAppt)] " & _
"WHERE ((([qryNoAccess(byAppt)].BANumber) <> 'HSG0008 20') And
(([qryNoAccess(byAppt)].AppointmentOutcomeID) = 'N') And
(([qryNoAccess(byAppt)].ActionTypeID) = 'AS')) " & _
"GROUP BY [qryNoAccess(byAppt)].CouncilDistrict " & _
"PIVOT [qryNoAccess(byAppt)].Week"
rsDW.CursorLocation = adUseClient
rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet4.Range("B25").CopyFromRecordset rsDW
rsDW.Close
Set rsDW = Nothing
cnnDW.Close
Set cnnDW = Nothing
frmData.Hide
Exit Sub
Err:
MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error,
vbCritical, "HSG NA Trending"
MsgBox VBA.Err
End Sub
Thanks,
Jez
This is my query below trying to extract data from Access into Excel. I am
having trouble withthe second part of the query. It works fine to bring in
the first SQL but then fails on the second and gives me this error message
"Operation is not allowed when the object is open"
I dont understand why its going wrong when I havent closed the connection
between the database but only closed when created the recordset.. How can I
fix this problem, as I may want to add another SQL to it?
Option Explicit
Dim cnnDW As ADODB.Connection
Dim rsDW As ADODB.Recordset
Dim sQRY As String
Dim strDWFilePath, strCSVFilePath, strDestFilePath, strDestFileName As String
Sub GetData()
On Error GoTo Err:
strDWFilePath = "H:\NCHO\Housing Services\Data Warehouse\HSG Data
Warehouse.mdb"
Set cnnDW = New ADODB.Connection
Set rsDW = New ADODB.Recordset
'ASV N Week by Contract
Sheet4.Range("B5:BB23").ClearContents
cnnDW.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDWFilePath & ";"
sQRY = "TRANSFORM Count([qryNoAccess(byAppt)].WRNumber) AS
CountOfWRNumber " & _
"SELECT [qryNoAccess(byAppt)].CouncilName " & _
"FROM [qryNoAccess(byAppt)] " & _
"WHERE ((([qryNoAccess(byAppt)].BANumber) <> 'HSG0008 20') And
(([qryNoAccess(byAppt)].AppointmentOutcomeID) = 'N') And
(([qryNoAccess(byAppt)].ActionTypeID) = 'AS')) " & _
"GROUP BY [qryNoAccess(byAppt)].CouncilName " & _
"PIVOT [qryNoAccess(byAppt)].Week"
rsDW.CursorLocation = adUseClient
rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet4.Range("B5").CopyFromRecordset rsDW
rsDW.Close
Set rsDW = Nothing
Set rsDW = New ADODB.Recordset
'ASV N Week by Neigbourhood
Sheet4.Range("B25:BB79").ClearContents
cnnDW.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strDWFilePath & ";"
sQRY = "TRANSFORM Count([qryNoAccess(byAppt)].WRNumber) AS
CountOfWRNumber " & _
"SELECT [qryNoAccess(byAppt)].CouncilDistrict " & _
"FROM [qryNoAccess(byAppt)] " & _
"WHERE ((([qryNoAccess(byAppt)].BANumber) <> 'HSG0008 20') And
(([qryNoAccess(byAppt)].AppointmentOutcomeID) = 'N') And
(([qryNoAccess(byAppt)].ActionTypeID) = 'AS')) " & _
"GROUP BY [qryNoAccess(byAppt)].CouncilDistrict " & _
"PIVOT [qryNoAccess(byAppt)].Week"
rsDW.CursorLocation = adUseClient
rsDW.Open sQRY, cnnDW, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet4.Range("B25").CopyFromRecordset rsDW
rsDW.Close
Set rsDW = Nothing
cnnDW.Close
Set cnnDW = Nothing
frmData.Hide
Exit Sub
Err:
MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error,
vbCritical, "HSG NA Trending"
MsgBox VBA.Err
End Sub
Thanks,
Jez