This article describes a solution for Microsoft Excel-SQL Server import-export using VBA and ADO.
There are two ways to import SQL Server data to Microsoft Excel using VBA:
- To create a QueryTable connected to a database table.To insert database data to a range using ADO Recordset.
The QueryTable object has a native Excel feature to refresh data. So user can refresh the data when needed without additional coding.
To refresh data inserted to a range using ADO just insert the data again. This way requires a control which runs the refresh macro.
The simplest way to export Excel data to SQL Server using VBA is to use ADO.
The example code is working in Microsoft Excel 2003, 2007 and 2010.
But object models of Microsoft Excel 2007 and 2003 are quite different.If possible migrate all project users to Microsoft Excel 2010. It is saves many hours and nerves for developers.
The example data are stored in SQL Azure and you can test the solution right after download.
Table of Contents
IntroductionSQL Server Data Import to Excel using QueryTable Function ImportSQLtoQueryTableTest CodeSQL Server Data Import to Excel using ADO Function ImportSQLtoRangeTest CodeExcel Data Export to SQL Server Function ExportRangeToSQLTest CodeConnection String Functions Function OleDbConnectionStringFunction GetTestConnectionStringFunction GetTestQueryConclusionSee AlsoSQL Server Data Import to Excel using QueryTableFunction ImportSQLtoQueryTable
The function creates a Excel native QueryTable connected to the OLE DB data source specified by the conString.
The result is nearly the same as a result of the standard Excel connection dialog.
Function ImportSQLtoQueryTable(ByVal conString As String, ByVal query As String, _ ByVal target As Range) As Integer On Error Resume Next Dim ws As Worksheet Set ws = target.Worksheet Dim address As String address = target.Cells(1, 1).address ' Procedure recreates ListObject or QueryTable If Not target.ListObject Is Nothing Then ' Created in Excel 2007 or higher target.ListObject.Delete ElseIf Not target.QueryTable Is Nothing Then ' Created in Excel 2003 target.QueryTable.ResultRange.Clear target.QueryTable.Delete End If If Application.Version >= 12 Then ' Excel 2007 or higher With ws.ListObjects.Add(SourceType:=0, Source:=Array("OLEDB;" & conString), _ Destination:=Range(address)) With .QueryTable .CommandType = xlCmdSql .CommandText = Array(query) .BackgroundQuery = True .SavePassword = True .Refresh BackgroundQuery:=False End With End With Else ' Excel 2003 With ws.QueryTables.Add(Connection:=Array("OLEDB;" & conString), _ Destination:=Range(address)) .CommandType = xlCmdSql .CommandText = Array(query) .BackgroundQuery = True .SavePassword = True .Refresh BackgroundQuery:=False End With End If ImportSQLtoQueryTable = 0End Function
Code comments:
The query parameter can contain SELECT or EXECUTE query.The result data will be inserted starting the left top cell of the target range.If the target range contains ListObject or QueryTable object it will be deleted and a new object will be created instead.If you need to change the query only just change the QueryTable.CommandText property.Pay attention to .SavePassword = True line.Microsoft Excel stores passwords without encryption.If possible use trusted connection which, unfortunately, not supported by SQL Azure.SQL Server Data Import to Excel using QueryTable Test Code
Sub TestImportUsingQueryTable() Dim conString As String conString = GetTestConnectionString() Dim query As String query = GetTestQuery() Dim target As Range Set target = ThisWorkbook.Sheets(1).Cells(3, 2) Select Case ImportSQLtoQueryTable(conString, query, target) Case Else End SelectEnd Sub
To top
SQL Server Data Import to Excel using ADOFunction ImportSQLtoRange
The function inserts SQL Server data to the target Excel range using ADO.
Function ImportSQLtoRange(ByVal conString As String, ByVal query As String, _ ByVal target As Range) As Integer On Error Resume Next ' Object type and CreateObject function are used instead of ADODB.Connection, ' ADODB.Command for late binding without reference to ' Microsoft ActiveX Data Objects 2.x Library ' ADO API Reference ' http://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx ' Dim con As ADODB.Connection Dim con As Object Set con = CreateObject("ADODB.Connection") con.ConnectionString = conString ' Dim cmd As ADODB.Command Dim cmd As Object Set cmd = CreateObject("ADODB.Command") cmd.CommandText = query cmd.CommandType = 1 ' adCmdText ' The Open method doesn't actually establish a connection to the server ' until a Recordset is opened on the Connection object con.Open cmd.ActiveConnection = con ' Dim rst As ADODB.Recordset Dim rst As Object Set rst = cmd.Execute If rst Is Nothing Then con.Close Set con = Nothing ImportSQLtoRange = 1 Exit Function End If Dim ws As Worksheet Dim col As Integer Set ws = target.Worksheet ' Column Names For col = 0 To rst.Fields.Count - 1 ws.Cells(target.row, target.Column + col).Value = rst.Fields(col).Name Next ws.Range(ws.Cells(target.row, target.Column), _ ws.Cells(target.row, target.Column + rst.Fields.Count)).Font.Bold = True ' Data from Recordset ws.Cells(target.row + 1, target.Column).CopyFromRecordset rst rst.Close con.Close Set rst = Nothing Set cmd = Nothing Set con = Nothing ImportSQLtoRange = 0End Function
Code comments:
The query parameter can contain SELECT or EXECUTE query.The result data will be inserted starting the left top cell of the target range.The use of the Object type and the CreateObject function instead of the direct use of the ADO types lets to avoid the ActiveX Data Objects 2.x Library reference setup on user computers.This code works on Microsoft Excel 2003, 2007 and 2010.Always use Set Nothing statement for ADODB.Connection and ADODB.Recordset objects to free resources.SQL Server Data Import to Excel using ADO Test Code
Sub TestImportUsingADO() Dim conString As String conString = GetTestConnectionString() Dim query As String query = GetTestQuery() Dim target As Range Set target = ThisWorkbook.Sheets(2).Cells(3, 2) target.CurrentRegion.Clear Select Case ImportSQLtoRange(conString, query, target) Case 1 MsgBox "Import database data error", vbCritical Case Else End SelectEnd Sub
To top
Excel Data Export to SQL ServerFunction ExportRangeToSQL
The functions exports the sourceRange data to a table with the table name.
The optional beforeSQL is executed before the export and the optional afterSQL is executed after the export.
The common logic of the export process:
- Delete all data from a temporary import table.Export Excel data to the empty temporary import table.Update desired tables from the temporary import table data.
Specially developed stored procedures are used at the first and third steps.And a universal code is used to transfer Excel data to a destination table.
Function ExportRangeToSQL(ByVal sourceRange As Range, _ ByVal conString As String, ByVal table As String, _ Optional ByVal beforeSQL = "", Optional ByVal afterSQL As String) As Integer On Error Resume Next ' Object type and CreateObject function are used instead of ADODB.Connection, ' ADODB.Command for late binding without reference to ' Microsoft ActiveX Data Objects 2.x Library ' ADO API Reference ' http://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx ' Dim con As ADODB.Connection Dim con As Object Set con = CreateObject("ADODB.Connection") con.ConnectionString = conString con.Open ' Dim cmd As ADODB.Command Dim cmd As Object Set cmd = CreateObject("ADODB.Command") cmd.CommandType = 1 ' adCmdText If beforeSQL > "" Then cmd.CommandText = beforeSQL cmd.ActiveConnection = con cmd.Execute End If ' Dim rst As ADODB.Recordset Dim rst As Object Set rst = CreateObject("ADODB.Recordset") With rst Set .ActiveConnection = con .Source = "SELECT * FROM " & table .CursorLocation = 3 ' adUseClient .LockType = 4 ' adLockBatchOptimistic .CursorType = 0 ' adOpenForwardOnly .Open ' Column mappings Dim tableFields(100) As Integer Dim rangeFields(100) As Integer Dim exportFieldsCount As Integer exportFieldsCount = 0 Dim col As Integer Dim index As Integer For col = 1 To .Fields.Count - 1 index = Application.Match(.Fields(col).Name, sourceRange.Rows(1), 0) If index > 0 Then exportFieldsCount = exportFieldsCount + 1 tableFields(exportFieldsCount) = col rangeFields(exportFieldsCount) = index End If Next If exportFieldsCount = 0 Then ExportRangeToSQL = 1 Exit Function End If ' Fast read of Excel range values to an array ' for further fast work with the array Dim arr As Variant arr = sourceRange.Value ' The range data transfer to the Recordset Dim row As Long Dim rowCount As Long rowCount = UBound(arr, 1) Dim val As Variant For row = 2 To rowCount .AddNew For col = 1 To exportFieldsCount val = arr(row, rangeFields(col)) If IsEmpty(val) Then Else .Fields(tableFields(col)) = val End If Next Next .UpdateBatch End With rst.Close Set rst = Nothing If afterSQL > "" Then cmd.CommandText = afterSQL cmd.ActiveConnection = con cmd.Execute End If con.Close Set cmd = Nothing Set con = Nothing ExportRangeToSQL = 0End Function
Code comments:
The preliminary column mappings is used for fast transfer of Excel range column data to a Recordset column.The Excel data types are not verified.The use of the Object type and the CreateObject function instead of the direct use of the ADO types lets to avoid the ActiveX Data Objects 2.x Library reference setup on user computers.This code works on Microsoft Excel 2003, 2007 and 2010.Always use Set Nothing statement for ADODB.Connection and ADODB.Recordset objects to free resources.Excel Data Export to SQL Server Test Code
The temporary table dbo02.ExcelTestImport is used for Excel data inserts.
This table is cleared before the export using the stored procedure dbo02.uspImportExcel_Before.
The stored procedure dbo02.uspImportExcel_After updates the source table dbo02.ExcelTest with values from dbo02.ExcelTestImport.
This technique simplifies the Excel part of an application but requires additional database objects and server side coding.
Sub TestExportUsingADO() Dim conString As String conString = GetTestConnectionString() Dim table As String table = "dbo02.ExcelTestImport" Dim beforeSQL As String Dim afterSQL As String beforeSQL = "EXEC dbo02.uspImportExcel_Before" afterSQL = "EXEC dbo02.uspImportExcel_After" Dim ws As Worksheet Set ws = ThisWorkbook.ActiveSheet Dim qt As QueryTable Set qt = GetTopQueryTable(ws) Dim sourceRange As Range If Not qt Is Nothing Then Set sourceRange = qt.ResultRange Else Set sourceRange = ws.Cells(3, 2).CurrentRegion End If Select Case ExportRangeToSQL(sourceRange, conString, table, beforeSQL, afterSQL) Case 1 MsgBox "The source range does not contain required headers", vbCritical Case Else End Select ' Refresh the data If Not qt Is Nothing Then Call RefreshWorksheetQueryTables(ws) ElseIf ws.Name = ws.Parent.Worksheets(1).Name Then Else Call TestImportUsingADO End IfEnd Sub
The procedure updates all worksheet QueryTables after the export.
Sub RefreshWorksheetQueryTables(ByVal ws As Worksheet) On Error Resume Next Dim qt As QueryTable For Each qt In ws.QueryTables qt.Refresh BackgroundQuery:=True Next Dim lo As ListObject For Each lo In ws.ListObjects lo.QueryTable.Refresh BackgroundQuery:=True NextEnd Sub
The function searches a QueryTable object connected to a database.
If there are some QueryTables on the worksheet then the most top QueryTable is returned.
Function GetTopQueryTable(ByVal ws As Worksheet) As QueryTable On Error Resume Next Set GetTopQueryTable = Nothing Dim lastRow As Long lastRow = 0 Dim qt As QueryTable For Each qt In ws.QueryTables If qt.ResultRange.row > lastRow Then lastRow = qt.ResultRange.row Set GetTopQueryTable = qt End If Next Dim lo As ListObject For Each lo In ws.ListObjects If lo.SourceType = xlSrcQuery Then If lo.QueryTable.ResultRange.row > lastRow Then lastRow = lo.QueryTable.ResultRange.row Set GetTopQueryTable = lo.QueryTable End If End If NextEnd Function
To top
Connection String FunctionsFunction OleDbConnectionString
If the Username parameter is empty the function returns a connection string for trusted connection.
Function OleDbConnectionString(ByVal Server As String, ByVal Database As String, _ ByVal Username As String, ByVal Password As String) As String If Username = "" Then OleDbConnectionString = "Provider=SQLOLEDB.1;Data Source=" & Server _ & ";Initial Catalog=" & Database _ & ";Integrated Security=SSPI;Persist Security Info=False;" Else OleDbConnectionString = "Provider=SQLOLEDB.1;Data Source=" & Server _ & ";Initial Catalog=" & Database _ & ";User ID=" & Username & ";Password=" & Password & ";" End IfEnd Function
Function GetTestConnectionString
The code is working for SQL Server and SQL Azure.
Function GetTestConnectionString() As String GetTestConnectionString = OleDbConnectionString( _ "xng46oamrm.database.windows.net", "AzureDemo", _ "excel_user@xng46oamrm", "ExSQL_#02") ' GetTestConnectionString = OleDbConnectionString(".", "AzureDemo", "", "")End Function
Function GetTestQuery
The both SELECT and EXECUTE query types can be used.
Function GetTestQuery() As String GetTestQuery = "SELECT * FROM dbo02.ExcelTest" ' GetTestQuery = "EXEC dbo02.uspExcelTest"End Function
To top
Conclusion
You can use this code to import-export data between Microsoft Excel and SQL Server.
The code is working with SQL Server 2005/2008/R2 and SQL Azure in Microsoft Excel 2003/2007/2010.
If possible migrate all project users to Microsoft Excel 2010 which has the newest object model which quite different from the object models of the previous Excel versions.
import-export-excel-sql-server-vba.zip
世界上那些最容易的事情中，拖延时间最不费力。
