SQL Server Data Import to Excel using ADO
1) The function inserts SQL Server data to the target Excel range using ADO.
Function ImportSQLtoExcel(sheet As String, row As Long, column As Long, commandText As String) As Integer ' requires a reference to the object library "Microsoft ActiveX Data Objects 2.x Library" under Options > Tools > References... in the Visual Basic Editor. Dim rangesheet As String rangesheet = Sheets(sheet).Cells(row + 1, column).Address Dim database As String Dim UID As String Dim PWD As String database = Sheets("Configuration").Cells(2, Range("Configuration[[#All],[CONFIGURATION_DATABASE]]").column).Value UID = Sheets("Configuration").Cells(2, Range("Configuration[[#All],[UID]]").column).Value PWD = Sheets("Configuration").Cells(2, Range("Configuration[[#All],[PWD]]").column).Value Dim connectionsheet As String connectionsheet = OdbcConnectionStringSQLServer("SQL Server", Server, database, UID, PWD) Dim cnt As ADODB.Connection Set cnt = New ADODB.Connection cnt.ConnectionString = connectionsheet cnt.Open Dim cmd As ADODB.Command Set cmd = New ADODB.Command Set cmd.ActiveConnection = cnt cmd.commandText = commandText cmd.CommandType = adCmdText ' Object type and CreateObject function are used instead of ADODB.RECORDSET, ' After late binding without reference to ' Microsoft ActiveX Data Objects 2.x Library Dim rs As Object Set rs = CreateObject("ADODB.RECORDSET") rs.ActiveConnection = cnt rs.Open commandText, cnt 'Deletes ListObjet or QueryTable if already exist If Sheets(sheet).ListObjects.Count > 0 Then 'created in Excel 2007 or higher For Each tbl In Sheets(sheet).ListObjects tbl.Delete Next tbl ElseIf Sheets(sheet).QueryTables.Count > 0 Then ' Created in Excel 2003 For Each tbl In Sheets(sheet).QueryTables tbl.ResultRange.Clear tbl.Delete Next tbl End If With Sheets(sheet).ListObjects.Add(SourceType:=3, Source:=rs, Destination:=Range(Sheets(sheet).Cells(row, column).Address)).QueryTable .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCell .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .ListObject.Name = displayname .ListObject.ShowTotals = False .Refresh BackgroundQuery:=False End With Sheets(sheet).ListObjects(displayname).TableStyle = "TableStyleMedium9" ImportSQLtoExcel = 0 CloseRecordset: rs.Close Set rs = Nothing CloseConnection: cnt.Close Set cnt = Nothing End Function
Function OdbcConnectionStringSQLServer(ByVal Driver As String, ByVal Server As String, ByVal database As String, _ ByVal Username As String, ByVal Password As String) As String 'SQL Server OdbcConnectionStringSQLServer = "Driver={" & Driver & "};Server=" & Server _ & ";UID=" & Username & ";PWD=" & Password & ";Database=" & database End Function









