writing copyfromrecordset to range

问题

I've got the following vba, it reads in the MCO from cell C10 onwards until its empty and will grab the number of machines, number of decrypts and upgrading machines from a SQL database.

That works fine but I'm having trouble getting the data in the corresponding row. At the moment it always write the data to D10 coz I've hard coded it but I'm not sure how to get this to increment or write to the same row that the MCO has been read in from. I'm having the same problem if the record set is empty. I'd like to insert 0 0 0 in to the 3 columns

Any help would be most appreciated

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

回答1:

It might be easiest to include the Excel sheet as a joined table. For example:

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

With any links to SQL Server, you need to be fairly confident that you are working with clean data.

Note that I have referred to Cells. If you do not like the idea of connecting the sheet, you can also refer to cells and step, for example For i=1 To MaxRows

来源：https://stackoverflow.com/questions/10812424/writing-copyfromrecordset-to-range

标签

sql

sql-server-2005

vba