Question

我在下面有以下代码：

Function downloadsqltoexcel(conn As ADODB.Connection, sSQL As String, exceldestinationrangename As String, sqltablename As String, bDownload As Boolean, Optional ws As Worksheet) As Variant

'================================================================================================================================
'== Procedure Name: downloadsqltoexcel
'== Purpose: downloads SQL table data (or query data) to Excel named range or grabs a specific value from an SQL table
'== Notes: ensure that SQL table or query name and Excel named range are identical
'================================================================================================================================

Dim rsPubs As ADODB.Recordset
Set rsPubs = New ADODB.Recordset

Dim DestinationRange As Range

With rsPubs

    .ActiveConnection = conn
    .Open sSQL, conn, adOpenStatic, adLockReadOnly, adCmdText

    If bDownload Then 'if download switch is on, dump into Excel named range

        If ws Is Nothing Then
            Set DestinationRange = Range(exceldestinationrangename)
        Else
            Set DestinationRange = ws.Range(exceldestinationrangename)
        End If

        With DestinationRange
            .ClearContents
            .CopyFromRecordset rsPubs
        End With

   .... more code follows, but not relevant

代码本身执行得很好。但是，当我指向新创建的Prod SQLServer数据库时，.CopyFromRecordset rsPubs行返回非常奇怪的字符数据，该数据库也是直接从SQLServer中的QA数据库复制的。当我说非常奇怪时，我的意思是像空格混合日语字符或某些我甚至无法识别的字体集。

rsPubs按预期返回确切的记录计数，所以我知道我得到了我想要的结果。还确认根据需要将数据写入SQLServer DB。

任何想法如何修复它，以便值从调用Prod SQLServer DB按预期返回？

Answer 1

我也遇到了类似的问题，我强烈怀疑RecordSet中返回的记录数量很大。因此，CopyFromRecordSet无法正常工作。

我建议使用以下方法：

使用RecordSet数据在VBA中填充二维数组。

Dim arr为变体 arr = rs.GetRows（） rs.close conn.close
转置数组（因为这会导致倒置数组）

arr = Application.WorksheetFunction.Transpose（arr）
一旦数组被转置，就可以将数组写入工作表Range。

testWS.Range（“ A1”）。Resize（UBound（arr，1）+ 1，UBound（arr，2）

这对我有用。希望对您有用！

编码愉快！

Answer 2

我最终遍历了记录集，并将每个值一个一个地放置。就是说，提供的数组答案对于大型数据集可能会更快地工作。当时，这很适合我的需求并有效。

If bDownload Then 'if download switch is on, dump into Excel named range

            If ws Is Nothing Then
                Set DestinationRange = Range(exceldestinationrangename)
            Else
                Set DestinationRange = ws.Range(exceldestinationrangename)
            End If

            r = 0

            DestinationRange.ClearContents
            '.CopyFromRecordset rsPubs 'this is breaking on PDLOBList download (last column not showing up) 'PAQPT-488

            If .RecordCount > 0 Then
                .MoveFirst
                Do Until .EOF
                    For c = 0 To .Fields.Count - 1
                        DestinationRange.Offset(r, c).value = .Fields(c)
                    Next
                    .MoveNext
                    r = r + 1
                Loop

（我忽略了其他if个块，因为它们与该答案无关。）

CopyFromRecordset返回奇怪的字符

2 个答案: