Introduction
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
- Introduction
- SQL Server Data Import to Excel using QueryTable
- SQL Server Data Import to Excel using ADO
- Excel Data Export to SQL Server
- Connection String Functions
- Conclusion
- See Also
SQL Server Data Import to Excel using QueryTable
Function 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 = 0
End 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 Select
End Sub
SQL Server Data Import to Excel using ADO
Function 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 = 0
End 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 Select
End Sub
Excel Data Export to SQL Server
Function 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 = 0
End 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 If
End 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
Next
End 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
Next
End Function
Connection String Functions
Function 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 If
End 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
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.