Running SQL queries for Access using Excel VBA

I

ibeetb

I have code using OLE DB to go into Access and retrieve results using SQL
but it runs for forever.....and never stops. Can someone advise what is
going wrong. I run the same structure on a different Access DB (using a
different Select statement) and it works fine. It hangs when it trying to
Open the recordset after the SQL code.Here is the code:
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset

DBFullName = ThisWorkbook.Path & "\Supply.mdb"
Set cnn = New ADODB.Connection
Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
Cnct = Cnct & "Data Source=" & DBFullName & ";"
cnn.Open ConnectionString:=Cnct

'Set recordset as ADODB recordset
Set rs = New ADODB.Recordset
With Recordset
'Filter
Src = "SELECT [All Supply].[Resource ID], [All Supply].[New Resource
Group], [All Supply].[New Resource Type],"
Src = Src & " [All Supply].[Employee Status], [All Supply].[Employee
ID], [All Supply].[Teamplay Name], "
Src = Src & "[All Supply].[Cont / FTE], [All Supply].[Tech Mgr ID],
[All Supply].[Other Notes],"
Src = Src & " [Detailed to High Level - Groups].[High Level Group],
[Detailed to High Level - Groups].[Higher Level Group], "
Src = Src & " [Detailed to High Level - Types].[High Level Type]"
Src = Src & " FROM [All Supply], [Detailed to High Level -
Groups],[Detailed to High Level - Types]"
Src = Src & "WHERE [All Supply].[New Resource Group] Not Like
'Unknown' AND [All Supply].[Employee Status]='Active' AND "
Src = Src & "[All Supply].[Employee ID] Not Like '01*'"
Src = Src & " GROUP BY [All Supply].[Resource ID], [All Supply].[New
Resource Group], [All Supply].[New Resource Type], "
Src = Src & "[All Supply].[Employee Status], [All Supply].[Employee
ID], [All Supply].[Teamplay Name], "
Src = Src & "[All Supply].[Cont / FTE], [All Supply].[Tech Mgr ID],
[All Supply].[Other Notes], "
Src = Src & "[Detailed to High Level - Groups].[High Level Group],
[Detailed to High Level - Groups].[Higher Level Group], "
Src = Src & "[Detailed to High Level - Types].[High Level Type] "
Src = Src & "ORDER by [All Supply].[New Resource Group],[All
Supply].[New Resource Type]"
rs.Open Source:=Src, ActiveConnection:=cnn
(IT HANGS HERE)


ThisWorkbook.Sheets("Data").Columns("A:L").ClearContents
For col = 0 To rs.Fields.Count - 1
ThisWorkbook.Sheets("Data").Range("A1").Offset(0, col).Value = _
rs.Fields(col).Name
Next

ThisWorkbook.Worksheets("Data").Range("A2").CopyFromRecordset rs
End With
Set rs = Nothing
' Close the connection.
cnn.Close
Set cnn = Nothing
 
P

Patrick Molloy

have you tried setting the recordset to the recordset property of a pivot
table? You might find this a fair bit easier than mangling code.
Also, you might find creating a query in the mdb with parameters faster and
easier too.

ibeetb said:
I have code using OLE DB to go into Access and retrieve results using SQL
but it runs for forever.....and never stops. Can someone advise what is
going wrong. I run the same structure on a different Access DB (using a
different Select statement) and it works fine. It hangs when it trying to
Open the recordset after the SQL code.Here is the code:
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset

DBFullName = ThisWorkbook.Path & "\Supply.mdb"
Set cnn = New ADODB.Connection
Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
Cnct = Cnct & "Data Source=" & DBFullName & ";"
cnn.Open ConnectionString:=Cnct

'Set recordset as ADODB recordset
Set rs = New ADODB.Recordset
With Recordset
'Filter
Src = "SELECT [All Supply].[Resource ID], [All Supply].[New Resource
Group], [All Supply].[New Resource Type],"
Src = Src & " [All Supply].[Employee Status], [All Supply].[Employee
ID], [All Supply].[Teamplay Name], "
Src = Src & "[All Supply].[Cont / FTE], [All Supply].[Tech Mgr ID],
[All Supply].[Other Notes],"
Src = Src & " [Detailed to High Level - Groups].[High Level Group],
[Detailed to High Level - Groups].[Higher Level Group], "
Src = Src & " [Detailed to High Level - Types].[High Level Type]"
Src = Src & " FROM [All Supply], [Detailed to High Level -
Groups],[Detailed to High Level - Types]"
Src = Src & "WHERE [All Supply].[New Resource Group] Not Like
'Unknown' AND [All Supply].[Employee Status]='Active' AND "
Src = Src & "[All Supply].[Employee ID] Not Like '01*'"
Src = Src & " GROUP BY [All Supply].[Resource ID], [All Supply].[New
Resource Group], [All Supply].[New Resource Type], "
Src = Src & "[All Supply].[Employee Status], [All Supply].[Employee
ID], [All Supply].[Teamplay Name], "
Src = Src & "[All Supply].[Cont / FTE], [All Supply].[Tech Mgr ID],
[All Supply].[Other Notes], "
Src = Src & "[Detailed to High Level - Groups].[High Level Group],
[Detailed to High Level - Groups].[Higher Level Group], "
Src = Src & "[Detailed to High Level - Types].[High Level Type] "
Src = Src & "ORDER by [All Supply].[New Resource Group],[All
Supply].[New Resource Type]"
rs.Open Source:=Src, ActiveConnection:=cnn
(IT HANGS HERE)


ThisWorkbook.Sheets("Data").Columns("A:L").ClearContents
For col = 0 To rs.Fields.Count - 1
ThisWorkbook.Sheets("Data").Range("A1").Offset(0, col).Value = _
rs.Fields(col).Name
Next

ThisWorkbook.Worksheets("Data").Range("A2").CopyFromRecordset rs
End With
Set rs = Nothing
' Close the connection.
cnn.Close
Set cnn = Nothing
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a query's SQL code from excel 3
SQL Access Database Add record 1
SQL Code Access Database add record 1
Access ADO Excel and OLE Objects! 1
Excel range in SQL line-how to reference 1
Main form navigation button 3
Running custom Excel query for Access 5
Some observations 2

Top