从数据库复制数据到Excel如果从用户采取数据库名称？

我正在做一些macros，并从用户采取date和分贝。 在这个基础上，我从数据库中获取数据。

这里是我的代码，请看看和分享，如果你有任何解决这个。

Dim cn As New ADODB.Connection Dim rs As New ADODB.Recordset Function GetConnectionString() As String Dim strCn As String strCn = "Provider=sqloledb;" strCn = strCn & "Data Source=" & Range("Server") & ";" strCn = strCn & "Initial Catalog=" & Range("Database") & ";" If (Range("UserID") <> "") Then strCn = strCn & "User ID=" & Range("UserID") & ";" strCn = strCn & "password=" & Range("Pass") Else strCn = strCn & "Integrated Security = SSPI" End If GetConnectionString = strCn End Function Sub Test() ActiveWorkbook.Sheets("Sheet1").Activate Dim ws As Worksheet Dim Sql As String Dim d As String d = Range("A2").Value d = Format(d, "yyyy-mm-dd") cn.ConnectionTimeout = 100 cn.Open GetConnectionString() Sql = "select * from config where convert(date,logdate,103)='"& d &"'" ExecInsert (Sql) Set rs.ActiveConnection = cn rs.Open Sql ActiveWorkbook.Sheets("Sheet2").Activate Dim ws1 As Worksheet Range("A2").CopyFromRecordset (rs) 'This is where I'm getting error cn.Close End Sub Sub ExecInsert(selectquery As String) 'End Sub Dim cmd As New ADODB.Command cmd.CommandText = selectquery cmd.CommandType = adCmdText cmd.ActiveConnection = cn cmd.Execute End Sub 

Range("A2").CopyFromRecordset (rs)这是我得到错误的地方

运行types错误“430”类不支持自动化或不支持预期的接口

我拥有所有的DLL并注册它们。 甚至连我的最后都没有提及。

如果有任何机构面临这个问题，请帮助… … –

Answer 1

请更新下面的行

从

  Range("A2").CopyFromRecordset (rs) 

至

Range("A2").CopyFromRecordset rs

以下是示例代码

 Sub sub_success() Dim rsContacts As ADODB.Recordset Set rsContacts = New ADODB.Recordset With rsContacts .Fields.Append "ContactID", adInteger End With rsContacts.Open rsContacts.AddNew rsContacts!ContactID = 2123456 rsContacts.Update Sheet1.Range("A2").CopyFromRecordset rsContacts End Sub Sub sub_failure() Dim rsContacts As ADODB.Recordset Set rsContacts = New ADODB.Recordset With rsContacts .Fields.Append "ContactID", adInteger End With rsContacts.Open rsContacts.AddNew rsContacts!ContactID = 2123456 rsContacts.Update Sheet1.Range("A2").CopyFromRecordset (rsContacts) End Sub