написание copyfromrecordset до диапазона

Question

У меня есть следующая vba, она читается в MCO с ячейки C10 до ее пустой и будет захватывать количество машин, количество расшифров и машин для модернизации из базы данных SQL.

Это работает нормально, но у меня возникают проблемы с получением данных в соответствующей строке. На данный момент он всегда записывает данные в D10 coz. Я жестко закодировал его, но я не уверен, как заставить его увеличивать или записывать в ту же строку, с которой был прочитан 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 

Answer 1

Это может быть проще включить лист 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