Question

目前，我正在测试如何将数据从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

当我尝试使用宏时，我会收到一个消息框，如ImportSQLtoRange中的案例1中所设置的那样。但是，我不确定这是否意味着代码可以工作并且可以访问查询，或者这是一条错误消息。如果这表明它确实有效，我如何修改它，以便根据我的查询给出我想要的表格？

编辑：按照Kazimierz Jawor的建议，我发表了评论

On Error Resume Next

现在我收到如下错误：

单击“调试”显示来自

的错误

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

您可以从以下链接找到有关集成Excel和SQL Server的许多有用提示。

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

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

2 个答案: