FemmesFinal

I hope you know that this will go down on your permanent record
Oh yeah? Well, don’t get so distressed
Did I happen to mention that I’m impressed?

So go the lyrics from Kiss Off by the Violent Femmes pictured here. Great song from the 80’s. If you are not familiar with the Femmes, check ’em out – highly recommended.

However, today’s post is not about the Alternative Rock scene of the early 80’s. Rather, it is about ActiveX Data Objects (ADO) Recordsets.


    edit: As is my usual practice, I am going to use Late Binding in the sample snippets below. A discussion on Late / Early Binding is beyond the scope of this post. Please see these links for a detailed explanation of Late / Early Binding.

    1. Beyond Excel
    2. JP Software Technologies


Global Constants

Because I am using Late Binding, I am going to setup Global Constants for the various Enumerations I need for Command Types, Cursor Locations, Cursor Types and Lock Types. It takes a little bit of extra work, but I think it makes the code clearer:

Clear:

cmd.CommandType = gcladCmdText

Not clear:

cmd.CommandType = 1

See? The Constant is self-documenting and makes the code clearer.

Here’s all the Global Contants. I put them in a Module named “M_Globals” because I’m creative that way.

'Command Type Enumeration Values
    Public Const gcladCmdUnspecified = -1       'Unspecified type of command
    Public Const gcladCmdText = 1               'Evaluates CommandText as a textual definition of a command or stored procedure call
    Public Const gcladCmdTable = 2              'Evaluates CommandText as a table name whose columns are returned by an SQL query
    Public Const gcladCmdStoredProc = 4         'Evaluates CommandText as a stored procedure name
    Public Const gcladCmdUnknown = 8            'Default. Unknown type of command
    Public Const gcladCmdFile = 256             'Evaluates CommandText as the file name of a persistently stored Recordset. Used with Recordset.Open or Requery only.
    Public Const gcladCmdTableDirect = 512      'Evaluates CommandText as a table name whose columns are all returned. Used with Recordset.Open or Requery only. To use the Seek method, the Recordset must be opened with adCmdTableDirect. Cannot be combined with the ExecuteOptionEnum value adAsyncExecute.

'Cursor Location Enumeration Values
    Public Const gcladUseNone = 1               'OBSOLETE (appears only for backward compatibility). Does not use cursor services
    Public Const gcladUseServer = 2             'Default. Uses a server-side cursor
    Public Const gcladUseClient = 3             'Uses a client-side cursor supplied by a local cursor library. For backward compatibility, the synonym adUseClientBatch is also supported
    
'Cursor Type Enumeration Values
    Public Const gcladOpenUnspecified = -1      'Unspecified type of cursor
    Public Const gcladOpenForwardOnly = 0       'Default. A forward-only cursor. This improves performance when you need to make only one pass through a Recordset
    Public Const gcladOpenKeyset = 1            'A keyset cursor. Like a dynamic cursor, except that you can't see records that other users add, although records that other users delete are inaccessible from your Recordset. Data changes by other users are still visible.
    Public Const gcladOpenDynamic = 2           'A dynamic cursor. Additions, changes, and deletions by other users are visible, and all types of movement through the Recordset are allowed
    Public Const gcladOpenStatic = 3            'A static cursor. A static copy of a set of records that you can use to find data or generate reports. Additions, changes, or deletions by other users are not visible.

'Lock Type Enumeration Values
    Public Const gcladLockUnspecified = -1      'Unspecified type of lock. Clones inherits lock type from the original Recordset.
    Public Const gcladLockReadOnly = 1          'Default. Read-only records
    Public Const gcladLockPessimistic = 2       'Pessimistic locking, record by record. The provider lock records immediately after editing
    Public Const gcladLockOptimistic = 3        'Optimistic locking, record by record. The provider lock records only when calling update
    Public Const gcladLockBatchOptimistic = 4   'Optimistic batch updates. Required for batch update mode

Let The User Choose Which Worksheet To Load To The Recordset

In the function below, I use an InputBox Type:=8 to let the user choose a cell on the worksheet that contains the data that should be loaded into the recordset:

Public Function GetSelectedSheet(strPrompt As String, _
                                 strTitle As String) As String
     
    'Declare variables
        Dim ws                          As Worksheet
        Dim rng                         As Range
     
    'Users - select a cell on a worksheet
        Set rng = Application.InputBox( _
                                       Prompt:=strPrompt, _
                                       Title:=strTitle, _
                                       Default:=ActiveCell.Address, _
                                       Type:=8) 'Range selection
                     
    'Get the parent worksheet of the selected cell
        Set ws = rng.Parent
         
    'Pass the name of the worksheet to the function
        GetSelectedSheet = ws.Name
     
    'Tidy up
        Set rng = Nothing
        Set ws = Nothing
 End Function

And I call the function like this:

        'Get worksheet to be loaded into recordset
            strWorksheet = GetSelectedSheet(strPrompt:="Select a cell on the worksheet to be loaded into the recordset", _
                                            strTitle:="Worksheet To Recordset")

Save The Data To A New Workbook

I could not get the ADO code to work with data in the same workbook, so in the end I decided to just save the data the user selected out to a new workbook:

First, I added a workbook:

        'Create a new workbook to hold all data from the selected worksheet
            Set wbADO = Workbooks.Add

Then I sent the original workbook, the new workbook and the the worksheet that the user selected to a Private Sub to handle the copying:

Call the sub:

        'Copy everything from the selected worksheet to the new workbook
            Call CopyData(wbSource:=wb, _
                          wbDestination:=wbADO, _
                          strSource:=strWorksheet)

The Sub() to copy the entire worksheet from one workbook to another:

Private Sub CopyData(wbSource As Workbook, _
                     wbDestination As Workbook, _
                     strSource As String)
                     
    wbSource.Worksheets(strSource).Copy wbDestination.Worksheets(1)

End Sub

And then the cleanup:

        'Cleanup the destination workbook
            Call CleanupWorkbook(wb:=wbADO)

The Sub() to handle any cleanup chores:

Private Sub CleanupWorkbook(wb As Workbook)

    'Declare variables
        Dim i As Long
        
    'Rename worksheets
    'Delete unneeded worksheets
        With wb
            .Worksheets(1).Name = "Data"
            For i = .Sheets.Count To 2 Step -1
                .Sheets(i).Delete
            Next i
        End With

End Sub

Lastly, I saved and closed the new workbook, since the ADO Process will want to open the workbook

        'Save and close the data workbook
            With wbADO
                .SaveAs wb.Path & "\" & Mid(wb.Name, 1, Len(wb.Name) - 5) & "_ADO.xlsx", FileFormat:=xlOpenXMLWorkbook
                strWorkbookADO = wbADO.FullName
                .Close
            End With

Create A Range Object To Measure Inputs

I would like to measure the amount of rows and columns in the input Range so that after I load the Recordset I can compare the the Range Dimensions to the Recordset Dimensions.

        'Create a range object to measure source data against final recordset data
            Set ws = wb.Worksheets(strWorksheet)
            Set rng = ws.Range("A1").CurrentRegion

SQL String

I like to create a SQL string and then pass the SQL string to the CommandText Property of the Command Object. I think this makes troubleshooting and tuning the SQL easier:

        'SQL string
            strSQL = "SELECT * FROM [Data$]"

Create The ADO Connection Object

I like to encapsulate any objects I am creating. Here is the function to create the ADO Connection Object:

Public Function GetADOConnection() As Object

    Set GetADOConnection = CreateObject("ADODB.Connection")
  
End Function

And here is how I call it:

        'Create ADO Connection Object
            Set cn = GetADOConnection()

ADO Connection Strings

ADO Connection Strings can be a little challenging, luckily, we have ConnectionStrings.com to help us out. Link is at the bottom of the post. I am using Office 2013 with a workbook in xlOpenXMLWorkbook format (.xlsx). So this is the connection string I’ll be using:

cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & _
         "Data Source=" & strWorkbookADO & ";" & _
         "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'")

Create The ADO Command Object

Next, I’ll create the ADO Command Object and set some of the properties of the object. Note here that I am using one of the Global Contants that I declared earlier. I also pass my SQL string here:

        'Create ADO Command Object
            Set cmd = GetCommand()
            Set cmd.ActiveConnection = cn
            cmd.CommandType = gcladCmdText
            cmd.CommandText = strSQL                        'Pass SQL String to the command object

And here is the function to create the Command Object :

Public Function GetCommand() As Object

    Set GetCommand = CreateObject("ADODB.Command")
  
End Function

Create And Load The ADO Recordset

Next I need to create and load the recordset.

'Create ADO Recordset Object and load records
            Set rs = GetRecordset()
            With rs
                .CursorLocation = gcladUseClient
                .CursorType = gcladOpenDynamic
                .LockType = gcladLockOptimistic
                .Open cmd
            End With

And here is the encapsulated function that creates the ADO Recordset Object:

Public Function GetRecordset() As Object

    Set GetRecordset = CreateObject("ADODB.Recordset")
  
End Function

Check Recordset Results Against Expected Results

Lastly, I want to compare the Recordset results against expected results. Do do this I will count the number of records and fields in the Recordset and compare them against the number of rows and columns in the Range Object I created earlier:

        'Compare recordset results to original data
            Debug.Print "The recordset contains " & Format(rs.RecordCount, "##,##0") & " records and " & rs.Fields.Count & " fields"
            Debug.Print "The range contains " & Format(rng.Rows.Count - 1, "##,##0") & " rows and " & rng.Columns.Count & " columns" '-1 to discount header row

Returns:

The recordset contains 60,398 records and 23 fields
The range contains 60,398 rows and 23 columns

Everything is working as it should.

The Main Procedure

Sub PopulateRecordset()

    'Declare variables
        Dim wb As Workbook
        Dim wbADO As Workbook
        Dim ws As Worksheet
        Dim rng As Range
        Dim cn As Object
        Dim rs As Object
        Dim cmd As Object
        Dim strWorksheet As String
        Dim strSQL As String
        Dim strWorkbookADO As String
                
    'Excel environemnt
        With Application
            .ScreenUpdating = False
            .DisplayAlerts = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With

    'Initialize
        Set wb = ThisWorkbook
        
        'Get worksheet to be loaded into recordset
            strWorksheet = GetSelectedSheet(strPrompt:="Select a cell on the worksheet to be loaded into the recordset", _
                                            strTitle:="Worksheet To Recordset")
                                            
        'Create a new workbook to hold all data from the selected worksheet
            Set wbADO = Workbooks.Add
            
        'Copy everything from the selected worksheet to the new workbook
            Call CopyData(wbSource:=wb, _
                          wbDestination:=wbADO, _
                          strSource:=strWorksheet)
                          
        'Cleanup the destination workbook
            Call CleanupWorkbook(wb:=wbADO)
            
        'Save and close the data workbook
            With wbADO
                .SaveAs wb.Path & "\" & Mid(wb.Name, 1, Len(wb.Name) - 5) & "_ADO.xlsx", FileFormat:=xlOpenXMLWorkbook
                strWorkbookADO = wbADO.FullName
                .Close
            End With

        'Create a range object to measure source data against final recordset data
            Set ws = wb.Worksheets(strWorksheet)
            Set rng = ws.Range("A1").CurrentRegion

        'SQL string
            strSQL = "SELECT * FROM [Data$]"

        'Create ADO Connection Object
            Set cn = GetADOConnection()
            cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" & _
                     "Data Source=" & strWorkbookADO & ";" & _
                     "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'")

        'Create ADO Command Object
            Set cmd = GetCommand()
            Set cmd.ActiveConnection = cn
            cmd.CommandType = gcladCmdText
            cmd.CommandText = strSQL                        'Pass SQL String to the command object


        'Create ADO Recordset Object and load records
            Set rs = GetRecordset()
            With rs
                .CursorLocation = gcladUseClient
                .CursorType = gcladOpenDynamic
                .LockType = gcladLockOptimistic
                .Open cmd
            End With

        'Compare recordset results to original data
            Debug.Print "The recordset contains " & Format(rs.RecordCount, "##,##0") & " records and " & rs.Fields.Count & " fields"
            Debug.Print "The range contains " & Format(rng.Rows.Count - 1, "##,##0") & " rows and " & rng.Columns.Count & " columns" '-1 to discount header row
            
        'Tidy up
            'Close objects
                rs.Close
                cn.Close
                
            'Destroy objects
                Set rs = Nothing
                Set cmd = Nothing
                Set cn = Nothing
                Set rng = Nothing
                Set ws = Nothing
                Set wbADO = Nothing
                Set wb = Nothing
                
            'Excel environemnt
                With Application
                    .ScreenUpdating = True
                    .DisplayAlerts = True
                    .EnableEvents = True
                    .Calculation = xlCalculationAutomatic
                End With
                    
End Sub

Tidy up

Additional Resources

Downloads

Credits

    Data courtesy Microsoft Excel 2013 Building Data Models with PowerPivot by Alberto Ferrari and Marco Russo (Mar 25, 2013)

Final Thoughts

    I could not get the ADO to work with data in the same workbook that contains the code. That does not mean you cannot – I don’t know. I would generally invoke a FileDialogFilePicker function to select a file that contains the data for processing. That’s it for today. I’ll come back later with more stuff on working with Recordsets. Thanks, Dennis!
, , ,
Trackback

3 comments untill now

  1. […] In my last post on ADO Recordsets, I demonstrated some VBA to load a Worksheet Range into a Recordset – check it out here. […]

  2. Ronn Gusaas @ 2014-09-24 08:40

    I am wondering if you have done any work with updating a SharePoint list from Excel?
    I want to use SharePoint as the repository for project status (milestones, target dates, percent complete, etc.) but want to use Excel based status report templates as the UI.

    Any thoughts?

  3. Ronn,

    I was not able to update a SharePoint List from Excel. However, I was able to update the SharePoint List from Access and then pull down all updates from the SharePoint List to Excel for analysis.

Add your comment now