none
Use an Excel Range as an ado recordset RRS feed

  • Question

  • Hi,

     

    I want to use vba to create an ado recordset of a named range in Excel to that I can run a SQL query on it, does anyone have any advice.  I am trying this in Excel 2010.  Thanks

     

    Here is the code that I thought would work, ZipDemoData is a named range:

    Sub GetData()
    '   This demo requires a reference to the Microsoft ActiveX Data Objects 2.x Library
        Worksheets("DemoData").Activate
        Dim DBFullName As String
        Dim Cnct As String, SQL As String
        Dim Connection As ADODB.Connection
        Dim Recordset As ADODB.Recordset

        DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        Set Connection = New ADODB.Connection
        Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=NO;IMEX=1';"
        Connection.Open ConnectionString:=Cnct
       
        Set Recordset = New ADODB.Recordset
        With Recordset
            SQL = "SELECT T1.zip, T1.population, T1.white, T1.black, T1.indian, T1.asian, T1.hawaiian, T1.race_other, T1.hispanic " _
                & "FROM ZipDemoData AS T1 " _
                & "WHERE (((T1.Zip)='" & strZip & "'));"
            .Open Source:=SQL, ActiveConnection:=Connection

            For Col = 0 To Recordset.Fields.Count - 1
               Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name
            Next

            Range("A1").Offset(1, 0).CopyFromRecordset Recordset
        End With
        Set Recordset = Nothing
        Connection.Close
        Set Connection = Nothing

    End Sub

    But it give the following error:

    No value given for one or more required parameters.

    • Moved by Max Meng Monday, January 16, 2012 2:16 AM Moving to a more appropriate forum (From:Excel IT Pro Discussions)
    Friday, January 13, 2012 5:54 PM

Answers

  • Thanks, I was able to use the following code:

    ZipDemoData is a named range.  I had problem when I set HDR=No.

    Sub GetData()
    '   This demo requires a reference to the Microsoft ActiveX Data Objects 2.x Library
        Worksheets("DemoData").Activate
        Dim DBFullName As String
        Dim Cnct As String, strsQL As String
        Dim Cn As ADODB.Connection
        Dim Rs As ADODB.Recordset

        DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        Set Cn = New ADODB.Connection
        Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
        Cn.Open ConnectionString:=Cnct
       
        Set Rs = New ADODB.Recordset

            strsQL = "SELECT T1.zip, T1.population, T1.white, T1.black, T1.indian, T1.asian, T1.hawaiian, T1.race_other, T1.hispanic " _
                & "FROM ZipDemoData AS T1 " _
                & "WHERE (((T1.Zip)='" & strZip & "'));"
           
            Rs.Open strsQL, Cn, adOpenDynamic, adLockReadOnly

    '        For Col = 0 To Recordset.Fields.Count - 1
    '           Range("A1").Offset(0, Col).Value = Rs.Fields(Col).Name
    '        Next

            Range("A1").Offset(1, 0).CopyFromRecordset Rs

        Rs.Close
        Set Rs = Nothing
        Cn.Close
        Set Cn = Nothing

    End Sub

    • Marked as answer by mieds Monday, January 16, 2012 3:21 PM
    Monday, January 16, 2012 3:21 PM

All replies

  • hi

    I have another way to create ADO recordset.

    This is an example. I hope this would be helpful for you.

    Sub demoDisconnectedRecordset()
        Dim rsContacts As ADODB.Recordset
        Dim vArray As Variant
        Dim i As Long
        
        vArray = Sheet1.Range("A2:I1001").Value
        Set rsContacts = New ADODB.Recordset
        
        With rsContacts
        '// Define table
            .Fields.Append "ContactID", adInteger
            .Fields.Append "FirstName", adVarChar, 50
            .Fields.Append "LastName", adVarChar, 50
            .Fields.Append "Gender", adVarChar, 1
            .Fields.Append "Company", adVarChar, 100
            .Fields.Append "City", adVarChar, 30
            .Fields.Append "State", adVarChar, 30
            .Fields.Append "SalesRegion", adVarChar, 6
            .Fields.Append "Sales", adDouble
            .Fields.Append "Birthday", adDate
            
            .CursorLocation = adUseClient
            .CursorType = adOpenStatic
            
            .Open
            
            '// insert records
            For i = LBound(vArray) To UBound(vArray)
                .AddNew
                
                .Fields("ContactID").Value = i
                .Fields("FirstName").Value = vArray(i, LBound(vArray, 2))
                .Fields("LastName").Value = vArray(i, LBound(vArray, 2) + 1)
                .Fields("Gender").Value = vArray(i, LBound(vArray, 2) + 2)
                .Fields("Company").Value = vArray(i, LBound(vArray, 2) + 3)
                .Fields("City").Value = vArray(i, LBound(vArray, 2) + 4)
                .Fields("State").Value = vArray(i, LBound(vArray, 2) + 5)
                .Fields("SalesRegion").Value = vArray(i, LBound(vArray, 2) + 6)
                .Fields("Sales").Value = vArray(i, LBound(vArray, 2) + 7)
                .Fields("Birthday").Value = vArray(i, LBound(vArray, 2) + 8)
            
                .Update
            Next
            
            '// filtering on the recordset
            .Filter = "Sales > 4970000"
            
            '// print the recordset
            Do While Not .EOF
                
                Debug.Print .Fields("ContactID").Value, _
                    .Fields("FirstName").Value, _
                    .Fields("LastName").Value, _
                    .Fields("Gender").Value, _
                    .Fields("Company").Value, _
                    .Fields("City").Value, _
                    .Fields("State").Value, _
                    .Fields("SalesRegion").Value, _
                    .Fields("Sales").Value, _
                    .Fields("Birthday").Value
                
                .MoveNext
            Loop
            '// unlock filtering
            .Filter = ""
            
            '// sorting the recordset
            .Sort = "ContactID" & " DESC"
            
            '// print recordset
            Do While Not .EOF
                
                Debug.Print .Fields("ContactID").Value, _
                    .Fields("FirstName").Value, _
                    .Fields("LastName").Value, _
                    .Fields("Gender").Value, _
                    .Fields("Company").Value, _
                    .Fields("City").Value, _
                    .Fields("State").Value, _
                    .Fields("SalesRegion").Value, _
                    .Fields("Sales").Value, _
                    .Fields("Birthday").Value
                    
                .MoveNext
            Loop
            
        End With
        
        rsContacts.Close
        Set rsContacts = Nothing
    End Sub
    

     

     

    the below image is the data source of the vba code.

     


    the best time to plant a tree was twenty years ago. the second best time, is today (Chinese proverb) sjoo.kwak at gmail.com
    • Edited by SJOO Monday, January 16, 2012 8:48 AM
    Monday, January 16, 2012 8:44 AM
  • Thanks, I was able to use the following code:

    ZipDemoData is a named range.  I had problem when I set HDR=No.

    Sub GetData()
    '   This demo requires a reference to the Microsoft ActiveX Data Objects 2.x Library
        Worksheets("DemoData").Activate
        Dim DBFullName As String
        Dim Cnct As String, strsQL As String
        Dim Cn As ADODB.Connection
        Dim Rs As ADODB.Recordset

        DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        Set Cn = New ADODB.Connection
        Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
        Cn.Open ConnectionString:=Cnct
       
        Set Rs = New ADODB.Recordset

            strsQL = "SELECT T1.zip, T1.population, T1.white, T1.black, T1.indian, T1.asian, T1.hawaiian, T1.race_other, T1.hispanic " _
                & "FROM ZipDemoData AS T1 " _
                & "WHERE (((T1.Zip)='" & strZip & "'));"
           
            Rs.Open strsQL, Cn, adOpenDynamic, adLockReadOnly

    '        For Col = 0 To Recordset.Fields.Count - 1
    '           Range("A1").Offset(0, Col).Value = Rs.Fields(Col).Name
    '        Next

            Range("A1").Offset(1, 0).CopyFromRecordset Rs

        Rs.Close
        Set Rs = Nothing
        Cn.Close
        Set Cn = Nothing

    End Sub

    • Marked as answer by mieds Monday, January 16, 2012 3:21 PM
    Monday, January 16, 2012 3:21 PM
  • Hi

    While trying to implement the solution provided above , I get a run-time error stating: "The Microsoft Access database engine could not find the object 'Table1'. In the provided solution, the SQL query refers to 'ZipDemoData' which is a named range and I assumed that using a named range in the excel file I am working from would suffice. The named range referred to in my SQL script is Table1 (a table in Sheet1).

    My current code is (adapted from the above solution):
        Dim DBFullName As String
        Dim Cnct As String, strSQL As String, strTag As String
        Dim Cn As ADODB.Connection
        Dim Rs As ADODB.Recordset

        DBFullName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
        
        Worksheets("Sheet1").Activate
        
        Set Cn = New ADODB.Connection
        Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBFullName & "';Extended Properties='Excel 12.0;HDR=Yes;IMEX=1';"
        Cn.Open ConnectionString:=Cnct
        
        Set Rs = New ADODB.Recordset
            strTag = "PC-001"
            strSQL = "SELECT T1.[Tag Number], T1.[Description] " _
                & "FROM Table1 AS T1 " _
                & "WHERE (((T1.[Tag Number])='" & strTag & "'));"
            
    Rs.Open strSQL, Cn, adOpenDynamic, adLockReadOnly

    My question is therefore: Can you please assist me to understand how I should reference the source object?
    I noticed that this thread has been marked as answered in 2012, but I would sincerely appreciate assistance.
    Monday, February 22, 2016 11:31 AM
  • This is an old thread but I hope you will get this.

    I am getting an "Object Required" error on 

    vArray = Sheet1.Range("A2:I1001").Value

    Only mine is

    vArray = Sheet6.Range("C6:G25").Value

    What am I missing?

    Greg

    Monday, January 22, 2018 10:24 PM