Import Access Crosstab using ADO to Excel

[fastpants]

Hello

I have written the following code, however my code crashed out when it gets to the bolded section; when it tries to actrually run the query. It works on normal queries its just the corsstab queries where it has problems. Can someone help please?

Sub InboundLeads()

Dim cat As ADOX.Catalog
Dim cmd As ADODB.Command
Dim rst As ADODB.Recordset
Dim i As Integer
Dim strPath As String
Dim QryOne As String

QryOne = "1b Query_InboundLeads_Crosstab"

strPath = "\\network1\Daily Tracker\Database V2.mdb"

Set cat = New ADOX.Catalog
cat.ActiveConnection = "provider=microsoft.jet.oledb.4.0;" & _
                       "data source=" & strPath

<b>Set cmd = cat.Views(QryOne).Command</b>
Set rst = cmd.Execute

Sheets(2).Select
For i = 0 To rst.Fields.Count - 1
    Cells(1, i + 1).Value = rst.Fields(i).Name
Next
With ActiveSheet
    .Range("A2").CopyFromRecordset rst
    .Range(Cells(1, 1), _
        Cells(1, rst.Fields.Count)).Font.Bold = True
    .Range("A1").Select
End With

Selection.CurrentRegion.Columns.AutoFit
rst.Close

Set cmd = Nothing
Set cat = Nothing
    
End Sub

 

[xenou]

Hi,

I'm not sure that the use of the CMD object is correct here. Here's how I would write this (works for me in a quick test):

Of course you'll need to change the database path in the connection string. Assumes an Access 2003 database, not Access 2007 file formats.

[COLOR="Navy"]Sub[/COLOR] Foo()
[COLOR="Navy"]Dim[/COLOR] rs [COLOR="Navy"]As[/COLOR] ADODB.Recordset
[COLOR="Navy"]Dim[/COLOR] Query_Name [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]Const[/COLOR] CONNECTION_STRING = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=G:\SomeFolder\SomeDatabase.mdb;Persist Security Info=False"

    [COLOR="Navy"]Set[/COLOR] rs = [COLOR="Navy"]New[/COLOR] ADODB.Recordset
    Query_Name = "qry_282b"
    
    [COLOR="SeaGreen"]'//Open recordset and run query[/COLOR]
    rs.Open Query_Name, CONNECTION_STRING, adOpenDynamic, , adCmdStoredProc
    
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] rs.EOF [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]With[/COLOR] Sheets(2)
            [COLOR="SeaGreen"]'//Write Headers[/COLOR]
            [COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] rs.Fields.Count - 1
                .Cells(1, i + 1).Value = rs.Fields(i).Name
            [COLOR="Navy"]Next[/COLOR]
            [COLOR="SeaGreen"]'//Write Data[/COLOR]
            .Cells(2, 1).CopyFromRecordset rs
            [COLOR="SeaGreen"]'//Format[/COLOR]
            .Range(.Cells(1, 1), .Cells(1, rs.Fields.Count)).Font.Bold = True
            .Range(.Cells(1, 1), .Cells(1, rs.Fields.Count)).EntireColumn.AutoFit
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

    [COLOR="SeaGreen"]'//Close Recordset[/COLOR]
    rs.Close
    [COLOR="Navy"]Set[/COLOR] rs = [COLOR="Navy"]Nothing[/COLOR]