3

私はいくつかのマクロを作成し、ユーザーから日付とデータベースを取得しています。その上で、db からデータを取得しています。

これが私のコードです。これに対する解決策があれば、見て共有してください。

    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)ここでエラーが発生します

実行タイプ エラー '430' クラスは自動化をサポートしていないか、予期されるインターフェイスをサポートしていません

私はすべてのdllを持っており、それらも登録しました。そして、私の最後から欠落している参照さえありません。

体がこの問題に直面している場合は、助けてください...

4

1 に答える 1

3

以下の行を親切に更新してください

から

 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
于 2013-04-16T04:50:00.543 に答える