Running SQL queries for Access using Excel VBA

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

nevermind. I found my own problem
"ibeetb" <tb20169@aol.com> wrote in message
news:uc2a61crFHA.1252@TK2MSFTNGP09.phx.gbl...
>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
>

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" wrote:

> 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
>
>
>