Percorrer recordset em calendário

[FabianoSouza 5]

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>

 

[FabianoSouza 5]

Ufa... depois de duas semanas fritando os neurônios finalmente encontrei a solução.

Sei que o código está bagunçado...mal organizado... mas peguei da web pra adaptar. Agora que está funcionado vou deixar bonitinho heheh

 

Em linhas gerais, precisava criar um loop do recordset para cada iteração do loop que cria os dias do calendário.
 

Passo 1 - Recuperar o total de registros do recordset

Dim totalRs
totalRs = rs.Recordcount

Passo 2 - Criar loop do recordset dentro de cada iteração do loop de dias do mês.

...crio a TD aqui...

...Agora defino variáveis 
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 

... Agora crio o loop milagroso!
  'ISSO AQUI PEROCORRE O RECORDSET para cada dia do mês--------------
For x = 0 To totalRs
If Day(rs("Inicio")) = Day(dtCurViewDay) Then
Response.Write "<span "& "title="& Replace(rs("DatasDescricao")&" às "&rs("Hora")," ","&nbsp;")&">"
Response.Write rs("DatasDescricao")
Response.Write "</span>"
Else
exit for
End if
rs.MoveNext
Next

End if

Vejam o print como ficou lindão kkkk