excel - copyfromrecordset 返回空白列

Question

我正在创建一个到 Sybase 数据库的 ADODB 连接，将一条 SQL 语句执行到一个记录集中，然后使用 CopyFromRecordset 方法将记录集的内容粘贴到一个范围中。这一直运行良好，但我最近在工作中移动了 PC，现在其中一个列没有返回任何内容。

当我在 SQuirreL 中运行相同的 SQL 时，该列不为空。

如果我暂停 VBA 并尝试查看相关列/字段中的一个值(即即时窗口中的 ?rst.fields(1).value)，我会收到以下错误消息:

Run-time error '-2147467259 (80004005)': Unspecified error.

在 Squirrel results Metadata 选项卡中，有问题的列描述为:

ColumnIndex 2
 getColumnName CommentText
 getColumnTypeName text
 getPrecision 2147483647
 getScale 0
 isNullable 0
 getTableName xxxxxxx
 getSchemaName 
 getCatalogName 
 getColumnClassName java.sql.Clob
 getColumnDisplaySize 2147483647
 getColumnLabel CommentText
 getColumnType 2005
 isAutoIncrement FALSE
 isCaseSensitive FALSE
 isCurrency FALSE
 isDefinitelyWritable FALSE
 isReadOnly FALSE
 isSearchable FALSE
 isSigned FALSE
 isWritable TRUE

有问题的代码在下面，但是，如前所述，代码似乎不是问题，因为它以前工作过 - 有什么想法吗？

Sub ImportComments()

Dim wsData As Worksheet
Dim rng As Range
Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim x As Long
Dim rngSQL  As Range
Dim cell As Range
Dim sSQL As String
Dim sProvider As String
Dim sDS As String
Dim sDataSource As String
Dim sUser As String
Dim sCatalog As String
Dim sPassword As String
Dim rngDS As Range
Dim rngThisDS As Range
Dim sConnect As String
Dim sInstance As String
Dim fSuccess As Boolean
Dim sError As String

On Error GoTo ProcExit

'delete previous comments if they exist
If SheetExists("Comments_Data_Import", ThisWorkbook) = True Then
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("Comments_Data_Import").Delete
    Application.DisplayAlerts = True
End If

'create comments sheet
Set wsData = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets("EWI_Data_Import"))
wsData.Name = "Comments_Data_Import"

'build sql string
Set rngSQL = Range(ThisWorkbook.Sheets("SQL").Range("A2"), _
                ThisWorkbook.Sheets("SQL").Range("A2").End(xlDown))
For Each cell In rngSQL
    sSQL = sSQL & cell.Value & " "
Next cell

'define login components
Set rngDS = ThisWorkbook.Worksheets("Login").Range("rngInstance").CurrentRegion
Set rngDS = rngDS.Offset(1, 0).Resize(rngDS.Rows.Count - 1)
sProvider = "Provider=ASEOLEDB.1;"
sUser = "User ID=" & ThisWorkbook.Worksheets("Login").Range("rngUsername").Value & ";"
sPassword = "Password=" & ThisWorkbook.Worksheets("Login").Range("rngPassword").Value

'try to log in to each instance exiting when succesful
Set cn = New ADODB.Connection
cn.CommandTimeout = 600

'turn off error hadling to allow for connection errors    On Error Resume Next

For Each rngThisDS In rngDS.Rows

    'complete connect string
    Err = 0
    sInstance = rngThisDS.Cells(1, 1)
    sDS = "Data Source=" & rngThisDS.Cells(1, 2) & ";"
    sCatalog = "Initial Catalog=" & rngThisDS.Cells(1, 3) & ";"
    sConnect = sProvider & sDS & sUser & sCatalog & sPassword


    'attempt to open
    cn.Open sConnect

    'If successful Then
    If Err = 0 Then

        'flag success
        fSuccess = True

        'execute SQL
        On Error GoTo ProcError
        Set rst = cn.Execute(sSQL)

        'copy data into comments sheet
        wsData.Range("A2").CopyFromRecordset rst


        'Put in the headers
        Set rng = wsData.Range("A1")
        For x = 1 To rst.Fields.Count
            rng.Offset(0, x - 1).Value = rst.Fields(x - 1).Name
        Next x
        FormatComments
        Exit For
    End If

Next rngThisDS

If fSuccess = False Then
    MsgBox ("Unable to connect to Insight")
Else
       MsgBox "Connected to and exported data from " & sInstance
End If

ProcExit:
Set wsData = Nothing
Set rng = Nothing
Set cn = Nothing
Set rst = Nothing
Set rngSQL = Nothing
Set cell = Nothing
Set rngDS = Nothing
Set rngThisDS = Nothing

Exit Sub

ProcError:

    MsgBox "Error: " & Err.Description
    Resume ProcExit

End Sub

Answer 1

根据CopyFromRecordset() MSDN :

When this method copies the recordset to the worksheet, the results will be truncated if you do not specify a range that is large enough to hold the contents of the recordset.

考虑使用 MoveFirst 指定范围命令重置:

' Copy data into comments sheet
rst.MoveLast
rst.MoveFirst
wsData.Range("A2:Z500").CopyFromRecordset rst

或整个工作表(从 A1 开始，当然为列标题插入行)

wsData.Cells.CopyFromRecordset rst

但即便如此， CopyFromRecordset()对数据和粗略类型甚至内存都很敏感(因为您一次提取所有数据并转储)，因此请考虑完全替换该方法并遍历行的记录。甚至其他语言(PHP、Python、Java 等)也以这种方式运行查询，打开游标并遍历结果集。

' Put in the headers
Set rng = wsData.Range("A1")
For x = 1 To rst.Fields.Count
      rng.Offset(0, x - 1).Value = rst.Fields(x - 1).Name
Next x

' Put in rows
Dim col As Integer, row As Integer
rst.MoveLast
rst.MoveFirst

Set rng = wsData.Range("A2")
row = 0
Do While Not rst.EOF
    For col = 0 To rst.Fields.Count - 1
            rng.Offset(row, col).Value = rst(col)
    Next col
    row = row + 1
    rst.MoveNext
Loop