将 copyfromrecordset 写入范围

我有以下 vba，它从单元格 C10 开始读取 MCO，直到其为空，并将从 SQL 数据库获取机器数量、解密和升级机器数量。

这工作正常，但我在获取相应行中的数据时遇到问题。目前它总是将数据写入 D10，因为我已经对其进行了硬编码，但我不确定如何使其递增或写入 MCO 已从中读取的同一行。如果记录集为空，我也会遇到同样的问题。我想将 0 0 0 插入到 3 列中

非常感激任何的帮助

Sub Summary_Click()

Dim MyConnObj As New ADODB.Connection 'ADODB Connection Object
Dim myRecSet As New ADODB.Recordset 'Recordset Object
Dim sqlStr As String ' String variable to store sql command

Range("D9:F34").Select
Range("D9:F34").Clear

Range("C10").Select

Set myRecSet = New ADODB.Recordset

Do Until IsEmpty(ActiveCell)
    strMCO = ActiveCell.Value

    MyConnObj.Open _
        "Provider = sqloledb;" & _
        "Data Source=xxx;" & _
        "Initial Catalog=xxx;" & _
        "User ID=xxx;" & _
        "Password=xxx;"

    strqa = " SELECT Count (distinct DeviceData.machinename) As [Number Of Devices], sum(case buildstatus when 'Decrypted' then 1 else 0 end) Decrypted, sum(case buildstatus when 'Upgrading' then 1 else 0 end) Upgrading, SiteList.Region "
    strqb = " FROM dbo.DeviceData JOIN dbo.SiteList ON dbo.DeviceData.CurrentSite = dbo.SiteList.SiteCode"
    strqc = " where MCO = '" & strMCO & "' "
    strqd = " group by DeviceData.Country, SiteList.Region"

    sqlStr = strqa & strqb & strqc & strqd

    myRecSet.Open sqlStr, MyConnObj, adOpenKeyset

    ActiveCell.Offset(0, 1).Select

    ActiveSheet.Range("D10").CopyFromRecordset myRecSet
    'ActiveSheet.Range("D<10 + 1>).CopyFromRecordset myRecSet

    If myRecSet.RecordCount = 0 Then
        ActiveSheet.Range("D10, E10, F10") = "0"
    End If

    ActiveCell.Offset(1, -1).Select
    MyConnObj.Close
Loop

End Sub

将 Excel 工作表包含为连接表可能是最简单的方法。例如：

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

''Not the best way to get the name
strFile = ActiveWorkbook.FullName

''2007 / 2010 connection
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 12.0 xml;HDR=Yes;"";"

cn.Open strCon

''ODBC Connection for sql server
scn = "[ODBC;DRIVER=SQL Server;SERVER\Instance;" _ 
    & "Trusted_Connection=Yes;DATABASE=Test]"

sSQL = "SELECT a.Stuff, b.ID, b.AText FROM [Sheet5$] a " _
& "INNER JOIN " & scn & ".table_1 b " _             
& "ON a.Stuff = b.AText"
rs.Open sSQL, cn

ActiveWorkbook.Sheets("Sheet7").Cells(1, 1).CopyFromRecordset rs

对于任何到 SQL Server 的链接，您需要相当确信您正在使用干净的数据。

请注意，我已经提到了细胞。如果您不喜欢连接工作表的想法，您还可以参考单元格和步骤，例如For i=1 To MaxRows