rs q nao esta recebendo o select

nao apresenta nenhum erro , mas ele nao esta abrindo .nome de tabela nao é pq eu testei .pq ele vai no 1 while e ele ja sai e vai pro segundo while , e na verdade ele deveria entrar no if . o rs nao deve estar recebendo o select . pq ?Conexao :

Global cn As ADODB.ConnectionGlobal rs As ADODB.RecordsetGlobal rs2 As ADODB.RecordsetGlobal agenda As StringPrivate Sub Main()Dim strArquivo As StringDim strLocal As StringDim Conexao As StringSet cn = New ADODB.ConnectionSet cn = CreateObject("ADODB.Connection")Conexao = "Driver={SQL Server};" & _"Server=RAFAEL;" & _"Database=Dentista;" & _"Uid=sa;Pwd=janio1;"cn.Open ConexaoAgendamento.ShowEnd Sub
Private Sub Form_Load()campo_data.Caption = Calendario.ValueSet rs = cn.Execute(" Select from Agendar_Consulta where data = '" & Date & "' ")Set rs2 = cn.Execute(" Select from Hora ") Dim item As ListItem While Not rs.EOF If rs.Fields("hora").Value = rs2.Fields("hora").Value Then Set item = ListView.ListItems.Add(, , rs("hora")) item.ListSubItems.Add , , rs("data") item.ListSubItems.Add , , rs("tel_res") item.ListSubItems.Add , , rs("tel_com") item.ListSubItems.Add , , rs("nom_pac") rs.MoveNext rs2.MoveNext Else Set item = ListView.ListItems.Add(, , rs2("hora")) item.ListSubItems.Add , , rs2("data") item.ListSubItems.Add , , rs2("tel_res") item.ListSubItems.Add , , rs2("tel_com") item.ListSubItems.Add , , rs2("nom_pac") rs2.MoveNext End If Wend While Not rs2.EOF Set item = ListView.ListItems.Add(, , rs2("hora")) rs2.MoveNext WendEnd Sub