Vba mssql via ado

butinas "Microsoft ActiveX Data Objects 2.8 Library" ar kitas.

Sub vba_mssql_via_ado()
Dim i As Integer
Dim query As String

ActiveSheet.Range("B2:B1000").Clear
i = 2
  While Len(Cells(i, "A")) > 0
        query = "SELECT itm.itmnam FROM itm WHERE itm.itmcod='" & Cells(i, "A") & "' " & _
        "AND itm.logcod='VOLVO' AND itm.compny='M1'"
        Cells(i, "B").Activate
        exQuery (query)
        i = i + 1
  Wend
End Sub

Function exQuery(query As String)
Dim cnnConnect As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Set cnnConnect = New ADODB.Connection
cnnConnect.Open "DRIVER={SQL Server};SERVER=ERPSRV01;UID=rainbow;PWD=$slaptazodis;DATABASE=RainbowLI"
Set rstRecordset = New ADODB.Recordset
rstRecordset.Open _
    Source:=query, _
    ActiveConnection:=cnnConnect, _
    CursorType:=adOpenDynamic, _
    LockType:=adLockReadOnly, _
    Options:=adCmdText
With ActiveSheet.QueryTables.Add( _
    Connection:=rstRecordset, _
    Destination:=ActiveCell)
    .FieldNames = False
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .PreserveColumnInfo = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .Refresh BackgroundQuery:=False
End With
End Function

siek tiek kitoks pvz.:

Sub vba_mssql_via_ado()
    Dim i, ii As Integer
    Dim query, m1 As String
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset

i = 2
While Len(Cells(i, "A")) > 0
query = "select pornum from pol where compny='M1' and lststs<>'60' and lincod='" & Cells(i, "A") & "'"
    Set cnn = New ADODB.Connection
    cnn.ConnectionString = "driver={SQL Server};" & _
    "server=ERPSRV01;uid=rainbow;pwd=$slaptazodis;database=RainbowLI"
    cnn.Open
    Set rs = cnn.Execute(query)

    Do Until rs.EOF
        For Each x In rs.Fields
        m1 = m1 & " " & rs(0) & " "
        Next
    rs.MoveNext
    Loop
    Cells(i, "D") = m1
    cnn.Close
    i = i + 1
Wend

End Sub