Sub test1()
  Dim cn As ADODB.Connection
  Dim rs As ADODB.Recordset
  
  Set cn = New Connection
  cn.Open "DSN=baas1"
  Set rs = cn.Execute("select teade from teated")
  'MsgBox rs("teade")
  reanr = 1
  While Not rs.EOF
    Cells(reanr, 1) = rs.Fields(0).Value
    reanr = reanr + 1
    rs.MoveNext
  Wend
  MsgBox rs.Fields(0).Name
  cn.Close
End Sub