RecordSet ADO有限回报

时间:2018-08-15 01:31:56

标签: excel vba excel-vba

简短的故事。我是公司的暑期实习生,也是VBA的新手。好吧,一个VBA资深人士一个月前离开了公司,她的代码不再正常运行。我找不到错误,我已经尝试了一切。

基本上,“ GetRecords”部分仅返回104个值,并且无法确认所提供的范围标准。任何建议都欢迎。下面是代码。我保证,我会好起来的。谢谢

Sub GetRecords(DSN As String, sqlString As String, sName As String)

Dim connection As New ADODB.connection
Dim recordSet As New ADODB.recordSet
Dim cmd As New ADODB.Command
Dim sDestination As Worksheet

Dim startDate As String
Dim endDate As String

Application.ScreenUpdating = False

startDate = Sheets("Main").Range("BEG_DATE").Value
endDate = Sheets("Main").Range("END_DATE").Value

connection.connectionString = "Provider=OraOLEDB.Oracle;" & _
                      "Data Source=" & DSN & _
                      ";User ID=user;" & _
                      "Password=password;"
connection.Open
Set cmd = New ADODB.Command
With cmd

.ActiveConnection = connection
.Parameters.Append .CreateParameter("O_BEG_DATE", adDate, adParamInput, , startDate)
.Parameters.Append .CreateParameter("o_END_DATE", adDate, adParamInput, , endDate)
.Properties("PLSQLRSet") = True
.CommandText = sqlString
.CommandType = adCmdText

Set recordSet = .Execute
.Properties("PLSQLRSet") = False
End With

Set sDestination = Sheets(sName)
sDestination.Cells.ClearContents

On Error Resume Next
    Dim i As Integer

    For i = 1 To recordSet.Fields.Count
        sDestination.Cells(1, i).Value = recordSet.Fields(i - 1).Name
    Next i

    sDestination.Range("A2").CopyFromRecordset recordSet
    sDestination.Columns.AutoFit

    'CopyFromRecordset will fail if the recordset contains an OLE
    'object field or array data such as hierarchical recordsets
    Application.ScreenUpdating = True

    If Err.Number <> 0 Then GoTo EarlyExit

EarlyExit:
    'Close and release the ADO objects
    recordSet.Close
    Set recordSet = Nothing
    Set cmd = Nothing

    connection.Close
    Set connection = Nothing
    On Error GoTo 0
End Sub

0 个答案:

没有答案