Hej,

Jag håller på och försöker koda en evenemangskalender och har stött på lite problem. Det är så att jag skulle vilja skriva ut alla måndagar, onsdagar och fredagar från dagens datum med en begränsning på 8st åt gången.

Jag skulle även vilja kolla om datumen finns inlagda i databasen (Access) och i så fall skriva ut posten.

Exempelvis:

Eftersom datumet i dag är 2006-11-17 så skulle följande skrivas ut.

Måndag 20/11 Standard text
Onsdag 22/11 Det fanns en post i databasen med detta datum så vi skriver ut rubriken.
Fredag 24/11 Standard text
Måndag 27/11 Standard text
Onsdag 29/11 Standard text
Fredag 1/12 Det fanns en post i databasen med detta datum så vi skriver ut rubriken.
Måndag 4/12 Standard text
Onsdag 6/12 Standard text

Och imorgon skulle måndag 20/11 försvinna och fredag 8/12 läggas till.

Vore kalas om någon kunde hjälpa mig på rätt väg med exempel eller tips.

Tabellstrukturen i databasen ser ut enligt följande.

cID
cDay
cMonth
cYear
cHedline
cEvent

Har även lite funderingar på om det är bra eller dumt att dela upp dagar, månader och år som jag har gjort, är det bättre att köra på ett datum fält?

först plocka ut då 8 dagar fr.o.m idag

<code=asp>
sql = "SELECT * FROM MyDates WHERE datumfält > '" & dateadd("d", -1, date()) & "' AND datumfält < '" & dateadd("d", 9, date()) & "' ORDER BY datumfält ASC"
</code>

Som du ser ovan så använder jag ett datumfält, finns inga som helst plus med att dela upp det som du gjort nu - inte enligt mig iaf :)

Sen ska vi lista ut dagarna då (måndag, onsdag och fredag)
Som bekant vet vi att veckorna börjar med söndag inom programmering (alltså är måndag dag nr2)

<code=asp>
set rs = connStr.open(sql)
while not rs.eof
select case datepart("w", rs("datumfält"))
case 2, 4, 6:
Do_Stuff_Here
case else: ' Not a monday, wednesday or friday
end select
rs.movenext
wend
</code>

Tack!

Ska titta på detta och återkommer...

Lovar inte att det funkar - jag är nyvaken :P

Jag får inte fram nått, inget felmeddelande, inget skrivs ut...

Sen skriver väl inte den koden ut datum om det inte finns något i databasen.

Jag har suttit och pillat lite själv och har lyckats att skriva ut allt som jag vill ha det. Problemet nu är bara att det skrivs ut för hela månaden och om det är i slutet av månaden så fylls det inte på från nästa månad.

Jag har gjort enligt följande:

Response.Write "<table>"& vbCrLf

Dim lngDate, lngYear, lngMonth, lngDay, lngWeekday, lngLastDay, datMonth

'Plockar fram datum
lngDate = Date()
lngYear = Year(lngDate)
lngMonth = Month(lngDate)

'Första dagen i månaden
datMonth = DateSerial(lngYear, lngMonth, 1)

'Dagens datum
lngDay = DatePart("d",lngDate,vbMonday)

'Antal dagar i månaden
lngLastDay = DateDiff("d", datMonth, DateAdd("m", 1, datMonth))

'Öppnar databasen
Call dbOpen(Connect)

'Tar fram poster från databasen
strSQL = "Select * From t_calendar Where cMonth ="& lngMonth &" And cYear ="& lngYear &" Order By cDay"
Set objRs = Connect.Execute(strSQL)

Do Until lngDay > lngLastDay

If Not objRs.EOF Then
If int(lngDay) = int(objRs("cDay")) Then
writePost = "true"
End If
End If

If lngDay>=1 And lngDay<=lngLastDay Then

If writePost = "true" Then

Response.Write "<tr><th scope=""row"">"& getWeekday(DatePart("w",lngYear &"-"& lngMonth &"-"& lngDay,vbMonday)) &" "& lngDay &"/"& lngMonth &"</th><td>"& objRs("cHeadline") &"</td></tr>"& vbCrLf
objRs.MoveNext
writePost = "false"

Else

lngWeekday = DatePart("w",lngYear &"-"& lngMonth &"-"& lngDay,vbMonday)

'Kollar om veckodag är måndag, onsdag eller fredag
If lngWeekday = 1 or lngWeekday = 3 or lngWeekday = 5 Then
Response.Write "<tr><th scope=""row"">"& getWeekday(DatePart("w",lngYear &"-"& lngMonth &"-"& lngDay,vbMonday)) &" "& lngDay &"/"& lngMonth &"</th><td>Standardtext</td></tr>"& vbCrLf
End If

End If

End If

lngDay = lngDay + 1

Loop

objRs.Close : Set objRs = Nothing
Call dbClose(Connect)

Response.Write "</table>"& vbCrLf

Du har ingen idé på hur man skulle kunna begränsa det så det bara är 8st som skrivs ut, även om det är slutet i en månad?

Ingen som vet???

Detta tror jag löser ditt problem:

<%@language="VBScript" %>
<!-- METADATA
	TYPE="TypeLib"
	NAME="Microsoft ActiveX Data Objects 2.6 Library"
	UUID="{00000206-0000-0010-8000-00AA006D2EA4}"
	VERSION="2.6" -->
<%Option Explicit%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" >
<head>
    <title>Checkboxes</title>
</head>
<body>
<%
Function ValidDay(Value)
	Select Case Weekday(Value)
	Case vbMonday, vbWednesday, vbFriday
			ValidDay = True
	End Select
End Function

Function GetDates(FirstDate, Count)
Dim I 
Dim Value
	ReDim Days(Count -1) 

	Value = Date()
	Do While I < Count
		If ValidDay(Value) Then
			Days(I)	= Value
			I = I + 1
		End IF
		Value = DateAdd("d", 1, Value)
	Loop
	GetDates = Days
End Function

Function SQLDate(Value)
	SQLDate = "#"& Month(Value) & "/" & Day(Value) & "/" & Year(Value) & "#"
End Function

Function FilterDay(FieldName, Value)
Dim Tomorrow
	Tomorrow = DateAdd("d",1,Value)
	FilterDay = "(" & FieldName & " >= " & SQLDate(Value) & " AND " & _
	            FieldName & " < " & SQLDate(Tomorrow) & ")"
End Function

Function FilterDates(FieldName, Value)
Dim I
	Redim Temp(UBound(Value))

	For I = 0 To UBound(Value)
		Temp(I) = FilterDay(FieldName, Value(I))
	Next
	FilterDates = Join(Temp, " OR ")	
End Function

Function OpenConnection()
Dim objConn
	Set objConn = CreateObject("ADODB.Connection")
	objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" + _
		         "Data Source=" & Server.MapPath("db.mdb") & ";" 
	Set OpenConnection = objConn
End Function

Function OpenRecordset(objConn, FieldName, Dates)
Dim objRs
Dim strSQL
	strSQL = "SELECT Calendar.*" + vbCrLf + _
	         "FROM Calendar" + vbCrLf + _
	         "WHERE " & FilterDates(FieldName, Dates) & vbCrLf + _
	         "ORDER BY Calendar.cDate;" 
	
	Set objRs = CreateObject("ADODB.Recordset")
	objRs.CursorLocation = adUseClient
	objRs.Open strSQL,objConn,adOpenStatic,adLockReadOnly
	Set OpenRecordset = objRs
End Function

Sub WriteHead(Value)
	Response.Write "<th>" + vbCrlf 
	Response.Write WeekdayName(Weekday(Value)) & " " & Day(Value) & "/" & Month(Value) & " "
	Response.Write "</th>" + vbCrlf
End sub

Sub WriteEvents(rs, DateField, TextField)
Dim Time
	If rs.EOF Then
		Response.Write "Standard text" + vbCrlf
	Else
		Do
			Response.Write "<div>" + vbCrLf
			Time = TimeSerial(Hour(DateField), Minute(DateField), 0) 
			If Time Then
				Response.Write FormatDateTime(Time, vbShortTime) & " " 
			End If
			Response.Write Server.HTMLEncode(TextField) + vbCrlf
			Response.Write "</div>" + vbCrlf
			
			rs.MoveNext
		Loop Until rs.EOF
	End If
End Sub

Dim objRs
Dim objConn

Dim Value
Dim Dates
	
	Dates = GetDates(Date, 8)

	Set objConn = OpenConnection()
	Set objRs = OpenRecordset(objConn, "cDate", Dates)
	
	Response.Write "<table>" + vbCrlf
	For Each Value in Dates
		Response.Write "<tr>" + vbCrlf
			Response.Write "<th>" + vbCrlf
			
				WriteHead Value
				
			Response.Write "</th>" + vbCrlf		
			Response.Write "<td>" + vbCrlf
			
				objRs.Filter = FilterDay("cDate", Value)
				WriteEvents objRs, objRs("cDate"), objRs("cHeadLine")
				
			Response.Write "</td>" + vbCrlf
		Response.Write "</tr>" + vbCrlf
	Next
	Response.Write "</table>" + vbCrlf
	
	objRs.Close
	objConn.Close 
	
%>
</body>
</html>

Hej Andreas

Har tittat på din kod och försökt testa den men får ett fel:

ADODB.Recordset (0x800A0BB9)
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.

Raden är:

objRs.CursorLocation = adUseClient

Tack för hjälpen...

Hej Andreas,

Jag tog bort Function OpenConnection() och använde min egen databaskoppling samt ändrade
Function OpenRecordset(objConn, FieldName, Dates) till:

Function OpenRecordset(Connect, FieldName, Dates)
Dim objRs
Dim strSQL
strSQL = "Select * From t_calendar Where "& FilterDates(FieldName, Dates) &" Order By cDate"
Set objRs = Connect.Execute(strSQL)
Set OpenRecordset = objRs
End Function

och då funka de kanon!
Tack så jätte mycket för hjälpen, du är guld!!!

Hej Andreas

Kom att tänkta på en sak... Som det är nu så visas bara poster som har ett datum som är på en måndag, onsdag eller fredag, men om det är en post som är på en torsdag eller lördag osv. så visas dom inte.

Skulle det vara svårt att få så även poster som är på tisdag, torsdag, lördag och söndag, dvs alla dagar i veckan, visas. Man skulle ju kunna lägga till vbSaturday osv i funktionen ValidDay men då kommer de ju att skrivas ut datum där det inte finns poster (standard text) med och de vill jag inte.

Hoppas du förstår hur jag menar, lite krångligt att förklara :)

<%@language="VBScript" %>
<!-- METADATA
	TYPE="TypeLib"
	NAME="Microsoft ActiveX Data Objects 2.6 Library"
	UUID="{00000206-0000-0010-8000-00AA006D2EA4}"
	VERSION="2.6" -->
<%Option Explicit%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" >
<head>
    <title>Checkboxes</title>
</head>
<body>
<table>
<%
Function ValidDay(Value)
	Select Case Weekday(Value)
	Case vbMonday, vbWednesday, vbFriday
		ValidDay = True
	End Select
End Function

Function OpenConnection()
Dim objConn
	Set objConn = CreateObject("ADODB.Connection")
	objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" + _
		         "Data Source=" & Server.MapPath("db.mdb") & ";" 
	Set OpenConnection = objConn
End Function

Function OpenRecordset(objConn, StartDate)
Dim objCmd
Dim objRs
	Set objCmd = CreateObject("ADODB.Command")
	Set objCmd.ActiveConnection = objConn
	objCmd.CommandText = "SELECT t_calendar.*" + vbCrLf + _
	         "FROM t_calendar" + vbCrLf + _
	         "WHERE t_calendar.cDate >= @StartDate" + vbCrLf + _
	         "ORDER BY t_calendar.cDate;" 
	
	objCmd.Parameters.Append objCmd.CreateParameter("@StartDate", adDate, adParamInput, , StartDate)
	
	Set objRs = CreateObject("ADODB.Recordset")
	objRs.CursorLocation = adUseClient
	objRs.Open objCmd, , adOpenForwardOnly, adLockReadOnly
	Set objRs.ActiveConnection = Nothing
	
	Set OpenRecordset = objRs
End Function

Sub WriteHead(Value)
	Response.Write "<th>" + vbCrlf 
	Response.Write WeekdayName(Weekday(Value)) & " " & Day(Value) & "/" & Month(Value) & " "
	Response.Write "</th>" + vbCrlf
End sub

Sub WriteDefault(Value)
%>
<tr>
	<th><%WriteHead Value%></th>
	<td>Standard text</td>
</tr>
<%
End sub


Function WriteEvents(rs, DateField, TextField, StartDate, StopDate)
	Do Until objRs.EOF 
		If DateField < StartDate Then
			objRs.MoveNext
		ElseIf DateField >= StopDate Then
			Exit Do
		Else
%>
<tr>
	<th><%WriteHead StartDate%></th>
	<td>
<%
			Do Until objRs.EOF 
				If DateField >= StopDate Then
					Exit Do
				Else	
					WriteEvent objRs, DateField, TextField
					objRs.MoveNext 
				End If
			Loop							
%>
	</td>
</tr>
<%			
			WriteEvents = True 
			Exit Do
		End If
	Loop
End function

Sub WriteEvent(rs, DateField, TextField)
Dim Time
	Response.Write "<div>" + vbCrLf
	Time = TimeSerial(Hour(DateField), Minute(DateField), 0) 
	If Time Then
		Response.Write FormatDateTime(Time, vbShortTime) & " " 
	End If
	Response.Write Server.HTMLEncode(TextField) + vbCrlf
	Response.Write "</div>" + vbCrlf			
End Sub

Sub WriteCalendar(rs, DateField, TextField, StartDate, Count)
Dim Index
Dim Today
Dim Tomorrow
	Today = StartDate
	Tomorrow = DateAdd("d", 1, Today)

	Do Until Index >= Count
		If WriteEvents(objRs, objRs("cDate"), objRs("cHeadline"), Today, Tomorrow) Then
			Index = Index + 1
		ElseIf ValidDay(Today) Then
			WriteDefault Today
			Index = Index + 1
		End If
		
		Today = Tomorrow
		Tomorrow = DateAdd("d", 1, Today)
	Loop
End Sub

Dim objRs
Dim objConn
Dim StartDate
	StartDate = Date()

	Set objConn = OpenConnection()
	Set objRs = OpenRecordset(objConn, StartDate)
	objConn.Close 

	WriteCalendar objRs, objRs("cDate"), objRs("cHeadline"), StartDate, 8
	
	objRs.Close
	
%>
</table>
</body>
</html>

Lite förklaringar:

<!-- METADATA
	TYPE="TypeLib"
	NAME="Microsoft ActiveX Data Objects 2.6 Library"
	UUID="{00000206-0000-0010-8000-00AA006D2EA4}"
	VERSION="2.6" -->

Denna koden använder inte filter utan antar att ditt resultat är soretarat på datum i stigande ordning.


Ger dig tillgång till ADO's konstanter. Förutsatt att du kör IIS och har Microsoft ActiveX Data Objects 2.6 Library på datorn.

Detta förklarar felmeddelandet:
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.

Tack Andreas!

Nu fungerar allt kanon, Det är bara en sak :) sorry att jag är så "omständlig" men tidigare så hade jag gjort så man kan ha en annan färg på varannan rad så här:

<code>
For Each Value in Dates

Dim tr, odd
tr = tr + 1
If tr Mod 2 = 0 Then
odd = ""
Else
odd = " class=""odd"""
End If

Response.Write "<tr"& odd &">"
Response.Write "<th>"
WriteHead Value
Response.Write "</th>"
Response.Write "<td>"
objRs.Filter = FilterDay("cDate", Value)
WriteEvents objRs, objRs("cDate"), objRs("cHeadLine")
Response.Write "</td>"
Response.Write "</tr>"& vbCrlf

Next
</code>

Men nu går ju inte de eftersom tr skrivs ut separat under WriteDefault och WriteEvents. Har försökt att få till det under WriteCalendar där jag antar att det ska vara men inte lyckats, har du något förslag?

Tack återigen för din hjälp!

Skicka med ett class argument till WriteEvents och WriteDefault funktionerna.

Sorry, men jag förstå inte riktigt hur du menar :(

Du får förtydliga vad du inte förstår?

Vet du vad ett argument/parameter är?

Lägg till ytterligare en argument/parameter till dessa två subrutiner WriteEvents och WriteDefault.

Typ subrutin med en argument/parameter:

Sub Foo(Bar)

End Sub

Subrutin med två argument/parameter:

Sub Foo(Bar, Abc)

End Sub

Jag har hjälpt dig så här långt. Den förändring du önskar anser jag trivial.
Du skall klara av att skriva den själv.

<%
Function WriteEvents(rs, DateField, TextField, StartDate, StopDate, IsHighlighted)
   If IsHighlighted = True Then TrColor="#eeeeee" Else TrColor="#ffffffe"

%>
<TR style="background-color:<%=TrColor%>">
<%
End function%>

Glöm inte att trixa med resten av koden så det blir rätt.

Jag föredrar personligen CSS så som Johan gjorde tidigare.
Finns det någon anledning till att du valt att inte använda CSS classer?

Om jag gör så här (något förkortat)

<code>
Function WriteEvents(rs, DateField, TextField, StartDate, StopDate, OddTr)

Dim odd
OddTr = OddTr + 1
If OddTr Mod 2 = 0 Then
odd = ""
Else
odd = " class=""odd"""
End If

Do Until objRs.EOF
...
Response.Write "<tr"& odd &">"
...
Loop
End function
</code>

Så fungerar det bra, men om jag gör lika på WriteDefault så blir 2 rader eftervarandra som får classen odd och det ska ju vara varannan.

<code>
Sub WriteDefault(Value, OddTr)
Dim odd
OddTr = OddTr + 1
If OddTr Mod 2 = 0 Then
odd = ""
Else
odd = " class=""odd"""
End If

Response.Write "<tr"& odd &">"
...
End sub
</code>

Varför blir det så?

De löste sig när jag flytta OddTr = OddTr + 1 till WriteCalendar.
Nu fungerar det kanon! :)

Tack så mycket för all hjälp!

Nu är jag stolt över dig. ;o)

Hej Andreas,

Har kört fast lite och skulle behöva din hjälp, vet inte riktigt vart jag ska börja, de står still.

I alla fall så som det är nu så skrivs det ut "standard texter" för de dagar som finns i funktionen ValidDay. Men jag skulle vilja att man kan ha "standard texter" för alla dagar i veckan, men att dom bara ska visas om det finns någon text. dvs. om det inte finns någon text för cThursday och cFriday så ska dom inte visas. Som du ser i koden nedan så hämtar jag ut "standard texterna" från tabellen t_weekdays.

Har du något förslag på hur man skulle kunna göra detta? vet inte var jag ska börja.

Har funderat på att ändra tabellen t_weekdays enligt följande:

ID (ID - Räknare)
active (AV/PÅ)
Weekday (vbMonday, vbTuesday osv)
Text (Standard text)

och sen ta fram dom dagar som har active ON till funktionen ValidDay, skulle detta kunna va nått?

<code>
Function ValidDay(Value)
Select Case Weekday(Value)
Case vbWednesday, vbFriday, vbSaturday
ValidDay = True
End Select
End Function

Function OpenRecordset(Connect, StartDate)
Dim objCmd
Dim objRs
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = Connect
objCmd.CommandText = "Select t_calendar.* From t_calendar Where t_calendar.cDate >= @StartDate Order by t_calendar.cDate;"
objCmd.Parameters.Append objCmd.CreateParameter("@StartDate", adDate, adParamInput, , StartDate)

Set objRs = CreateObject("ADODB.Recordset")
objRs.CursorLocation = adUseClient
objRs.Open objCmd, , adOpenForwardOnly, adLockReadOnly
Set objRs.ActiveConnection = Nothing

Set OpenRecordset = objRs
End Function

Sub WriteHead(Value)
Response.Write WeekdayName(Weekday(Value)) &" "& Day(Value) &"/"& Month(Value)
End sub

Sub WriteDefault(Value, OddTr, checkWeekday)
Dim odd, objRsWeekday
If OddTr Mod 2 = 0 Then
odd = " class=""odd"""
Else
odd = ""
End If

checkWeekday = Weekday(Value)

Response.Write "<tr"& odd &">"
Response.Write "<th>"
WriteHead Value
Response.Write "</th>"
Response.Write "<td>"

'Tar fram text för veckodagar
strSQL = "Select * From t_weekdays"
Set objRsWeekday = Connect.Execute(strSQL)
If checkWeekday = 4 Then
Response.Write(noHTML(objRsWeekday("cWednesday")))
ElseIf checkWeekday = 6 Then
Response.Write(noHTML(objRsWeekday("cFriday")))
ElseIf checkWeekday = 7 Then
Response.Write(noHTML(objRsWeekday("cSaturday")))
End If
objRsWeekday.Close : Set objRsWeekday = Nothing

Response.Write "</td>"
Response.Write "</tr>"& vbCrLf
End sub

Function WriteEvents(rs, DateField, TextField, StartDate, StopDate, OddTr)

Dim odd
If OddTr Mod 2 = 0 Then
odd = " class=""odd"""
Else
odd = ""
End If

Do Until objRs.EOF
If DateField < StartDate Then
objRs.MoveNext
ElseIf DateField >= StopDate Then
Exit Do
Else
Response.Write "<tr"& odd &">"
Response.Write "<th>"
WriteHead StartDate
Response.Write "</th>"
Response.Write "<td>"
Do Until objRs.EOF
If DateField >= StopDate Then
Exit Do
Else
WriteEvent objRs, DateField, TextField
objRs.MoveNext
End If
Loop
Response.Write "</td>"
Response.Write "</tr>"& vbCrLf

WriteEvents = True
Exit Do
End If
Loop
End function

Sub WriteEvent(rs, DateField, TextField)
Dim Time
Time = TimeSerial(Hour(DateField), Minute(DateField), 0)
If Time Then
Response.Write FormatDateTime(Time, vbShortTime) & " "
End If
Response.Write ""& checkText(TextField) &""
End Sub

Sub WriteCalendar(rs, DateField, TextField, StartDate, Count)
Dim Index
Dim Today
Dim Tomorrow
Dim OddTr
Dim checkWeekday

Today = StartDate
Tomorrow = DateAdd("d", 1, Today)

Do Until Index >= Count
If WriteEvents(objRs, objRs("cDate"), objRs("cHeadline"), Today, Tomorrow, OddTr) Then
Index = Index + 1
OddTr = OddTr + 1
ElseIf ValidDay(Today) Then
WriteDefault Today, OddTr, checkWeekday
Index = Index + 1
OddTr = OddTr + 1
End If
Today = Tomorrow
Tomorrow = DateAdd("d", 1, Today)
Loop

End Sub

Dim objRs, Connect, StartDate, strSQL

StartDate = Date()

'Öppnar databasen
Call dbOpen(Connect)

Response.Write "<h1>Kommande</h1>"& vbCrLf
Response.Write "<div id=""event-image"">"& vbCrLf

strSQL = "Select Top 1 * From t_calendar Where cDate >= #"& Date() &"# Order By cDate Asc"
Set objRs = Connect.Execute(strSQL)
If objRs.EOF Then
Response.Write "<img src=""/public/images/events/no-image_s.gif"" width=""155"" height=""219"" class=""event-img"" alt=""Bild saknas"" /></a>"& vbCrLf
Else
If objRs("cImgS") <> "0" Then
Response.Write ""& vbCrLf
Else
Response.Write ""& vbCrLf
End If
End If
objRs.Close : Set objRs = Nothing

Response.Write "</div>"& vbCrLf
Response.Write "<table>"& vbCrLf

Set objRs = OpenRecordset(Connect, StartDate)
WriteCalendar objRs, objRs("cDate"), objRs("cHeadline"), StartDate, 8

Response.Write "</table>"& vbCrlf

objRs.Close : Set objRs = Nothing
Call dbClose(Connect)
</code>

Ingen som kan hjälpa mig med detta? har verkligen kört fast...