Percorrer recordset em calendário

Encontrei esse código para gerar calendário e estou adaptando para meu uso.

O problema está na hora de percorrer um recordset e exibir os compromissos dentro das TD da tabela.

Quando há dois ou mais compromissos na mesma data, o loop falha, deixando de escrever os compromissos de outras datas.

Mas se houver apenas 1 compromisso por dia, funciona direitinho.

Ilustrando:

Isso funciona

Compromisso A - 10/07/2017

Compromisso B - 15/07/2017

Compromisso C - 18/07/2017

Isso não funciona

Compromisso A - 10/07/2017

Compromisso B - 15/07/2017

Compromisso C - 15/07/2017

Esse trecho é responsável por escrever o compromisso dentro da TD

Dim meuDia, meuMes, meuAno
meuDia = Day(rs("Inicio"))
meuMes = Month(rs("Inicio"))
meuAno = Year(rs("Inicio"))

If meuDia = Day(dtCurViewDay) AND meuMes = Month(dtCurViewDay) AND meuAno = Year(dtCurViewDay) Then
Response.Write "<span>" & rs("DatasDescricao") & "</span>"
rs.Movenext
End if

Suspeito que o problema esteja na linha "rs.Movebext". Talvez eu não esteja movimentando o RS no lugar correto do código.

Agora o código na íntegra (lembrando que estou adaptando o código, não criei do zero, tem umas functions que não sei pra que servem).

<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Option Explicit%>
<%
Function FormatStr(String)
on Error resume next
String = Replace(String, CHR(13), "")

	String = Replace(String, CHR(10) & CHR(10), "</P><P>")
	String = Replace(String, CHR(10), "<BR>")
	FormatStr = String

End Function

Dim dtToday
dtToday = Date()

Dim dtCurViewMonth ' First day of the currently viewed month
Dim dtCurViewDay ' Current day of the currently viewed month
Dim frmDate ' Date submitted by form

' if the GO button was used, build the date from the month and year

If InStr(1, Request.Form, "subGO", 1) > 0 then
if Request.Form("CURDATE_month") = "" then
tmpMonth = month(now())
else
tmpMonth = Request.Form("CURDATE_month")
End If

if Request.Form("CURDATE_year") = "" then
tmpyear = year(now())
else
tmpyear = Request.Form("CURDATE_year")
End If

tmpDate = "1 " & tmpMonth & " 1999"

mnth = Month(tmpDate)
frmDate = DateSerial(tmpyear, mnth, 1)
Else

frmDate = Request.Form("CURDATE")

end if

if Request("view_date") <> "" then
frmDate= DateSerial(year(Request("view_date")), month(Request("view_date")), 1)
end if
%>

<% REM This section defines functions to be used later on. %>
<% REM This sets the Previous Sunday and the Current Month %>
<%

'--------------------------------------------------
Function DtPrevSunday(ByVal dt)
Do While WeekDay(dt) > vbSunday
dt = DateAdd("d", -1, dt)
Loop
DtPrevSunday = dt
End Function
'--------------------------------------------------
%>

<%REM Set current view month from posted CURDATE, or
' the current date as appropriate.

' if posted from the form
' if prev button was hit on the form
If InStr(1, Request.Form, "subPrev", 1) > 0 Then
dtCurViewMonth = DateAdd("m", -1, frmDate)
' if next button was hit on the form
ElseIf InStr(1, Request.Form, "subNext", 1) > 0 Then
dtCurViewMonth = DateAdd("m", 1, frmDate)
' anyother time
Else
' date add in text box
If InStr(1, Request.Form, "subGO", 1) > 0 then
dtCurViewMonth = frmDate
Else
if Request("view_date") <> "" then
dtCurviewMonth = frmDate
else
dtCurViewMonth = DateSerial(Year(dtToday), Month(dtToday), 1)
End If
End If
End If
%>

<% '--------BEGINNING OF DRAW CALENDAR SECTION-------- %>
<%
Dim iDay, iWeek, sFontColor, dictDte(31,2), intCount
Dim strSql, rs

strSQL = ""

 strSQL = "SELECT "
 strSQL = strSQL &"CONVERT(VARCHAR(10), DatasDataInicio, 103) AS 'Inicio'"
 strSQL = strSQL &", DatasDescricao "
 strSQL = strSQL &" FROM tabDatas "
 strSQL = strSQL &" WHERE "
 strSQL = strSQL &" MONTH(DatasDataInicio) = DATEADD(DD,-1,MONTH(GETDATE()))"
 strSQL = strSQL &" AND"
 strSQL = strSQL &" YEAR(DatasDataInicio) = YEAR(GETDATE())"
 strSQL = strSQL &" OR "
 strSQL = strSQL &" MONTH(DatasDataInicio) = MONTH(GETDATE())"
 strSQL = strSQL &" AND "
 strSQL = strSQL &" YEAR(DatasDataInicio) = YEAR(GETDATE())"
 strSQL = strSQL &" OR"
 strSQL = strSQL &" MONTH(DatasDataInicio) = DATEADD(DD,+1,MONTH(GETDATE()))"
 strSQL = strSQL &" AND "
 strSQL = strSQL &" YEAR(DatasDataInicio) = YEAR(GETDATE())"
 strSQL = strSQL &" ORDER BY "
 strSQL = strSQL &" DatasDataInicio "
 strSQL = strSQL &" ASC"
 set rs = conexao.Execute (strSql)

 intCount= 0
 ' populate array with days of month
 on Error resume next

' do until rs.EOF
' if intCount > 31 then exit do
' if Day(rs("DatasDataInicio")) = intCount + 1 then
' dictDte(intCount, 1) = rs("DatasDescricao")
' rs.Movenext
' Else
' dictDte(intCount, 1) = " "
' End If
' dictDte(intCount, 2) = intCount + 1
' intCount = intCount + 1
' loop
%>

<!doctype html>

<html>
<head>
<meta charset="utf-8">
<link href="/App/HOME/agenda/calendario/CSS/calendario.css" rel="stylesheet" type="text/css" />
</head>

<body>
<table id="tabCalendario">

<tr>

<%
'-- criar colunas com dias da semana
For iDay = vbSunday To vbSaturday%>
<th> <%=UCase(WeekDayName(iDay))%></th>
<%Next %>
</tr>
<%
'--cria linhas de semanas
dtCurViewDay = DtPrevSunday(dtCurViewMonth)
Response.Write "<tbody>"
For iWeek = 0 To 5
Response.Write "<TR>"

Dim sBGCOLOR
sBGCOLOR = "#FFFFFF"
Dim ariaHoje
ariaHoje = "1"

'-- cria as datas do calendário
For iDay = 0 To 6
sBGCOLOR = "#FFFFFF"
ariaHoje = "1"
If Month(dtCurViewDay) = Month(dtCurViewMonth) Then
ariaHoje = "1"

'Marca dia atual
If dtCurViewDay = dtToday Then sBGCOLOR = "#C4E1FF"
else
sBGCOLOR = "#F5F5F5"
ariaHoje = ""
End If

Response.Write "<TD bgcolor=" & sBGCOLOR & ">"

'------------Caso seja o primeiro dia do mês, concatena o nome do mês abreviado
Dim primeiroDia
primeiroDia = ""
If Day(dtCurViewDay) = 1 Then
primeiroDia = " de " & MonthName(Month(dtCurViewDay),True)'true para mês abreviado
End if
Response.Write("<li value=" & Day(dtCurViewDay) &">"& Day(dtCurViewDay) & primeiroDia & "</li>")

'------------ Exibe compromissos do banco de dados
Dim meuDia, meuMes, meuAno
meuDia = Day(rs("Inicio"))
meuMes = Month(rs("Inicio"))
meuAno = Year(rs("Inicio"))

If meuDia = Day(dtCurViewDay) AND meuMes = Month(dtCurViewDay) AND meuAno = Year(dtCurViewDay) Then
Response.Write "<span>" & rs("DatasDescricao") & "</span>"
rs.Movenext
End if

dtCurViewDay = DateAdd("d", 1, dtCurViewDay)
Response.Write "</TD>"
Next

Response.Write "</TR>"
 Next
Response.Write "</tbody>"

%>
<%' --------END OF DRAW CALENDAR SECTION--------
conexao.Close
set conexao = nothing
%>

</table>
</body>
</html>

	 

	![imagem](https://forum.imasters.com.br/monthly_2017_07/calendario5.png.96e0311e93612bbea50f7c4f4643b8f0.png)