We use ADO (ActiveX Data Objects) to work with external Excel data residing in the worksheets of the same workbook.
ADO helps connect to a data source and specify the data set with which to Work using SQL(Structured Query Language).
SQL is the standard language for RDMS(relational database management systems) used to communicate with a database residing in the same workbook.
The SQL statements along with VBA execute queries against and retrieve data from database contained in the Excel worksheet
without relying on separate program such as SQL server or Microsoft Access.
The VBA' complex scripts to manipulate external data sets can be replaced by simple but powerful SQL query statement.
VBA requires the data source information in the form of a connection string pointing to an Excel workbook using two different connect.
The connection method 1.1 is preferred to the method 1.2, due to the fact that 1.2 method is the cause of error at the run time. Yet it is not clear on the cause of the error.
Dim MyConnect as string MyConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ActiveWorkbook.FullName & ";" & _ "Extended Properties=Excel 12.0"
Set cnn = New ADODB.Connection cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _ ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
The object library essential to ADO are listed below and must be preinstalled in the machine. Whether explicitly referencing to the object libraries are depending on the way of binding: early bind or late binding.
We need to define the data set, referred to as the recordset in ADO, to work with along with VBA.
A Recordset object is an object (ADODB.RecordSet) for the records and fields returned from the data source according to the SQL query statement.
The most common way to define a Recordset object is to open an existing table or query using the following VBA statement.
Object(Recordset).Method(Open) SQL_Statement, ConnectionString
rst.Open sqlquery, MyConnect
With early binding, it is necessary to explicitly point the Recordset object to the Object Library to expose the Recordset object to the object libraries of above 2.
'*********************************** 'Early Binding of the ADO '*********************************** Dim rst As ADODB.Recordset Set rst = New ADODB.Recordset rst.Open sqlquery, MyConnect
To enable the statment above and use early binding, you will need to create a reference to the appropriate object library
by choosing the Tools ⇨ References command in the Visual Basic Editor (VBE).
In the References dialog box, find the object libraries listed below and then place a check next to it.
'*********************************** 'Late Binding of the ADO '*********************************** Dim rst As Object Set rst = CreateObject("ADODB.Recordset") rst.Open sqlquery, MyConnect
The returned Recordset is a text file and program reads the text file and create an array arrResults.
With rst .Open sqlquery, MyConnect, adOpenStatic, adLockReadOnly .MoveFirst n = 0 Do Until .EOF n = n + 1 .MoveNext Loop Erase arrResults ReDim Preserve arrResults(n, .Fields.Count) .MoveFirst n = 0 Do Until .EOF n = n + 1 For i = 1 To .Fields.Count On Error Resume Next arrResults(n, i) = .Fields(i - 1) On Error GoTo 0 Next i .MoveNext Loop End With
4 different procedures for the same function are introduced below.
Option Explicit Option Base 1 Option Compare Text '*********************************************** '1. Microsoft Excel Driver-Early Binding '*********************************************** 'Early Binding (It is necessary to set up the reference to the object library. 'you explicitly point a client application to the server application’s Object Library 'to expose the server application’s object model during design time or while programming.) '-Microsoft Access 16.0 object library '-Microsoft ActiveX Data Objects 2.8 library '-Microsoft ActiveX Data Objects Recordsets 6.0 Library '***************************************************************************************** Sub AdodbConnect_Excel_Early() Dim strsql As String Dim myProject As Variant Dim ws As Worksheet Set ws = ActiveWorkbook.Worksheets(1) ws.Cells.ClearContents strsql = "SELECT [proj_id], [wbs_name] FROM [PROJWBS$] WHERE [proj_node_flag] = 'Y'" myProject = AdodbExcel_Early(strsql) With ws .Cells(2, 1).Resize(UBound(myProject), UBound(myProject, 2)) = myProject .Cells(1, 1).Resize(1, 2).Value = Array("proj_id", "wbs_name") .Columns("A:B").AutoFit .Cells(1, 1).Select End With End Sub Private Function AdodbExcel_Early(sqlquery As String) As Variant Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim arrResults() As Variant, i As Long, n As Long With Application .ScreenUpdating = False .DisplayAlerts = False End With DoEvents Set cnn = New ADODB.Connection Set rst = New ADODB.Recordset cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _ ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name cnn.Open With rst .Open sqlquery, cnn .MoveFirst n = 0 Do Until .EOF n = n + 1 .MoveNext Loop Erase arrResults ReDim Preserve arrResults(n, .Fields.Count) .MoveFirst n = 0 Do Until .EOF n = n + 1 For i = 1 To .Fields.Count On Error Resume Next arrResults(n, i) = .Fields(i - 1) On Error GoTo 0 Next i .MoveNext Loop End With AdodbExcel_Early = arrResults Set rst = Nothing End Function
'*************************************** '2. Microsoft Excel Driver-Late Binding '*************************************** Sub AdodbConnect_Excel_late() Dim strsql As String Dim myProject As Variant Dim ws As Worksheet Set ws = ActiveWorkbook.Worksheets(1) ws.Cells.ClearContents strsql = "SELECT [proj_id], [wbs_name] FROM [PROJWBS$] WHERE [proj_node_flag] = 'Y'" myProject = AdodbExcel_Late(strsql) With ws .Cells(2, 1).Resize(UBound(myProject), UBound(myProject, 2)) = myProject .Cells(1, 1).Resize(1, 2).Value = Array("proj_id", "wbs_name") .Columns("A:B").AutoFit .Cells(1, 1).Select End With End Sub Private Function AdodbExcel_Late(sqlquery As String) As Variant Dim cnn As Object, rst As Object Dim arrResults() As Variant, i As Long, n As Long With Application .ScreenUpdating = False .DisplayAlerts = False End With DoEvents Set cnn = CreateObject("ADODB.Connection") Set rst = CreateObject("ADODB.Recordset") cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _ ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name cnn.Open With rst .Open sqlquery, cnn .MoveFirst n = 0 Do Until .EOF n = n + 1 .MoveNext Loop Erase arrResults ReDim Preserve arrResults(n, .Fields.Count) .MoveFirst n = 0 Do Until .EOF n = n + 1 For i = 1 To .Fields.Count On Error Resume Next arrResults(n, i) = .Fields(i - 1) On Error GoTo 0 Next i .MoveNext Loop End With AdodbExcel_Late = arrResults Set rst = Nothing End Function
'*************************************************************************************** '3. Microsoft.ACE.OLEDB-Early Binding '*************************************************************************************** 'Early Binding (It is necessary to set up the reference to the object library. 'you explicitly point a client application to the server application’s Object Library 'to expose the server application’s object model during design time or while programming.) '-Microsoft Access 16.0 object library '-Microsoft ActiveX Data Objects 2.8 library '-Microsoft ActiveX Data Objects Recordsets 6.0 Library '***************************************************************************************** Sub AdodbConnect_ACE_Early() Dim strsql As String Dim myProject As Variant Dim ws As Worksheet Set ws = ActiveWorkbook.Worksheets(1) ws.Cells.ClearContents strsql = "SELECT [proj_id], [wbs_name] FROM [PROJWBS$] WHERE [proj_node_flag] = 'Y'" myProject = AdodbACE_Early(strsql) With ws .Cells(2, 1).Resize(UBound(myProject), UBound(myProject, 2)) = myProject .Cells(1, 1).Resize(1, 2).Value = Array("proj_id", "wbs_name") .Columns("A:B").AutoFit .Cells(1, 1).Select End With End Sub Private Function AdodbACE_Early(sqlquery As String) As Variant Dim MyConnect As String Dim rst As ADODB.Recordset Dim arrResults() As Variant, i As Long, n As Long DoEvents MyConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ActiveWorkbook.FullName & ";" & _ "Extended Properties=Excel 12.0" Set rst = New ADODB.Recordset With rst .Open sqlquery, MyConnect, adOpenStatic, adLockReadOnly .MoveFirst n = 0 Do Until .EOF n = n + 1 .MoveNext Loop Erase arrResults ReDim Preserve arrResults(n, .Fields.Count) .MoveFirst n = 0 Do Until .EOF n = n + 1 For i = 1 To .Fields.Count On Error Resume Next arrResults(n, i) = .Fields(i - 1) On Error GoTo 0 Next i .MoveNext Loop End With AdodbACE_Early = arrResults Set rst = Nothing MyConnect = "" End Function
'************************************************************** ''4. Microsoft.ACE.OLEDB-Late Binding '************************************************************** Sub AdodbConnect_ACE_Late() Dim strsql As String Dim myProject As Variant Dim ws As Worksheet Set ws = ActiveWorkbook.Worksheets(1) ws.Cells.ClearContents strsql = "SELECT [proj_id], [wbs_name] FROM [PROJWBS$] WHERE [proj_node_flag] = 'Y'" myProject = AdodbACE_Late(strsql) With ws .Cells(2, 1).Resize(UBound(myProject), UBound(myProject, 2)) = myProject .Cells(1, 1).Resize(1, 2).Value = Array("proj_id", "wbs_name") .Columns("A:B").AutoFit .Cells(1, 1).Select End With End Sub Private Function AdodbACE_Late(sqlquery As String) As Variant Dim rst As Object Dim MyConnect As String Dim arrResults() As Variant, i As Long, n As Long DoEvents Set rst = CreateObject("ADODB.Recordset") MyConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source=" & ActiveWorkbook.FullName & ";" & _ "Extended Properties=Excel 12.0" With rst .Open sqlquery, MyConnect .MoveFirst n = 0 Do Until .EOF n = n + 1 .MoveNext Loop Erase arrResults ReDim Preserve arrResults(n, .Fields.Count) .MoveFirst n = 0 Do Until .EOF n = n + 1 For i = 1 To .Fields.Count On Error Resume Next arrResults(n, i) = .Fields(i - 1) On Error GoTo 0 Next i .MoveNext Loop End With AdodbACE_Late = arrResults Set rst = Nothing MyConnect = "" End Function
User the shape with the associated Macro assigned to the shape.
1. Draw shape with text on the face of it.
2.vRight click the shape and press Assign Macro on the shortcut menu
3. Select a corresponding Macro to run on the dialog and click OK.
4. When you want to run the Macro, you can press the shape.
Dated on: 3 November 2019