我有一个SQL查询,我用完了Excel。目标是运行查询并将数据粘贴到指定位置:
Public Function Pull_SQL_Data()
''''On Error GoTo Err:
Worksheets("Data").Select
Range("B7").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1).Select
Loop
Range("B:S", ActiveCell.Offset(-1, 3)).ClearContents
Worksheets("Data").Select
Range("B7").Select
Dim cnPubs As New ADODB.Connection
Dim strConn As String
Dim rstRecordsets As New ADODB.Recordset
Dim intColIndex As Integer
Dim strSQL As Variant
Application.ScreenUpdating = False
Application.Cursor = xlWait
Set cnPubs = New ADODB.Connection
Set rsPubs = New ADODB.Recordset
Set outCell = Sheets("Data").Range("B7")
strSQL = Sheets("SQL").Range("G1")
strConn = "PROVIDER=SQLOLEDB;"
cnPubs.CommandTimeout = 240
strConn = strConn & "DATA SOURCE=CFS-Serversql;INITIAL CATALOG=UserAnalysis;"
strConn = strConn & "INTEGRATED SECURITY=sspi;"
cnPubs.Open strConn
With rsPubs
.ActiveConnection = cnPubs
.Open strSQL, cnPubs, adOpenStatic, adLockReadOnly, adCmdText
Sheets("Data").Range("B7:S500").ClearContents
Sheets("Data").Range("B4").CopyFromRecordset rsPubs
End With
rsPubs.Close
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
Application.Cursor = xlDefault
Exit Function
Err:
MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error, vbCritical, "SQL Connection"
MsgBox VBA.Err
Application.Cursor = xlDefault
Worksheets("DWH").Select
Range("A1").Select
End Function
跑步时我得到:
发生以下错误 - 需要对象“错误代码424.
为什么我遇到这个问题?
答案 0 :(得分:1)
这有用吗?
Public Function Pull_SQL_Data()
Dim ws As Worksheet
Dim cnPubs As ADODB.Connection
Dim rsPubs As ADODB.Recordset
Dim strConn As String
Dim strSQL As Variant
Set ws = Worksheets("Data")
Set cnPubs = New ADODB.Connection
Set rsPubs = New ADODB.Recordset
strSQL = Sheets("SQL").Range("G1").Value
strConn = "PROVIDER=SQLOLEDB;DATA SOURCE=CFS-Serversql;" & _
"INITIAL CATALOG=UserAnalysis;INTEGRATED SECURITY=sspi;"
cnPubs.Open strConn
rsPubs.Open strSQL, cnPubs, adOpenStatic, adLockReadOnly, adCmdText
ws.Range("B7:S500").ClearContents
If Not rsPubs.EOF Then
ws.Range("B4").CopyFromRecordset rsPubs
Else
MsgBox "No records were returned!"
End If
rsPubs.Close
cnPubs.Close
End Function