如何使用VBA将SQL Server数据导出到Excel？

目前，我正在testing如何将数据从SQL Server Management Studio导出到Excel以用于即将推出的项目。

我在网上查了一下，发现代码如下：

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 Sub TestImportUsingADO() Dim conString As String conString = "data source = server name; initial catalog = database; uid = name; password = password" Dim query As String query = "my query goes here" 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 

当我尝试使用macros时，我收到一个消息框，如在ImportSQLtoRange的情况1中设置。 但我不知道这是否意味着代码工作，并可以访问查询或这是一个错误消息。 如果这表明它确实工作，我该如何修改它，以便根据我的查询给出我想要的表格？

编辑：按照卡齐米日Jaworbuild议，我评论

 On Error Resume Next 

现在我得到一个错误，如下所示：

点击debugging显示错误来自

 con.open 

那是什么意思？

Answer 1

请尝试使用下面的代码

 Dim conn As New ADODB.Connection Dim conn As ADODB.Connection Set conn = New ADODB.Connection 

下面是例子：

  Sub GetDataFromADO() 'Declare variables' Set objMyConn = New ADODB.Connection Set objMyRecordset = New ADODB.Recordset Dim strSQL As String 'Open Connection' objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=localhost;Initial Catalog=MyDatabase;User ID=abc;Password=abc;" objMyConn.Open 'Set and Excecute SQL Command' strSQL = "select * from myTable" 'Open Recordset' Set objMyRecordset.ActiveConnection = objMyConn objMyRecordset.Open strSQL 'Copy Data to Excel' Do until objMyRecordset.EOF //Test whether the current record is after the last record 'Your Code Loop End Sub 

Answer 2

这样做怎么样？

 Sub GetDataFromADO() 'Declare variables' Set objMyconn = New ADODB.Connection Set objMyCmd = New ADODB.Command Set objMyRecordset = New ADODB.Recordset Dim rc As Long 'Open Connection' objMyconn.ConnectionString = "Provider=SQLOLEDB;Data Source=Your_Server_Name;Initial Catalog=Your_DB_Name; Integrated Security=SSPI;" objMyconn.Open 'Set and Excecute SQL Command' Set objMyCmd.ActiveConnection = objMyconn objMyCmd.CommandText = "select * from [Person].[BusinessEntity] " objMyCmd.CommandType = adCmdText objMyCmd.Execute 'Open Recordset' Set objMyRecordset.ActiveConnection = objMyconn objMyRecordset.Open objMyCmd 'Copy Data to Excel' 'ActiveSheet.Range("A1").CopyFromRecordset (objMyRecordset) Application.ActiveCell.CopyFromRecordset (objMyRecordset) rc = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ActiveSheet.Cells(rc + 1, 1).Select 'Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Value objMyconn.Close End Sub 

你可以从下面的链接中find许多关于整合Excel和SQL Server的有用技巧。

https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm