<%response.expires=0%>
<html>
<body>
<%
' moved some of your code down so the DB connection isn't open as long
dayarrays = split("Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday",",") ' this is for ease of dimming, reordering etc.
'part of the reasoning for this array will be more appearant later
[b]
for each dayarray in dayarrays
execute(dayarray & " = Array()") ' dynamically dims the dayarray variable as the variable's content as an array
next
[/b]
' establishing your connection, recordset etc
Dim founddate
[b]
founddate=FindDate(1,date(),1)
[/b]
Set rsitem = Server.CreateObject("ADODB.Recordset")
Set ObjConn = Server.CreateObject("ADODB.Connection")
strconnect = "dsn=menu;"
' [b] the strconnect value wasn't in there before, make sure you get it added/corrected[/b]
ObjConn.Open strConnect
Sql = "SELECT * FROM cafemenu WHERE menudate BETWEEN #" & founddate & "# AND #" & founddate+6 & "# Order by [now] asc"
'[b] PS there was a typo in the SQL string last time, it's founddate not foundate
' Please note the addition of #'s to the dates instead of single quotes
' if you're using ACCESS you need #'s
' if you're using SQL you'll need the single quotes[/b]
Set rsitem = ObjConn.Execute(Sql)
' these next few sections will be where it might get a little more confusing on you
' what's happening here is the dynamic determination of what weekday a menudate is on
' then adding the RSitem("menuitem") values to the day array, RSitem("menuitem") being an array of recordset items, the dish name, or whatever you're looking to store
' using this way first of all cuts down on hoards of visible code, and lots of conditional statements
' like determining if menudate is on a monday, then if/else add value to array, or proceed to determine if it's a tuesday etc
[b]
do while not rsitem.eof
Execute(dayname(rsitem("menudate")) & " = AddToArray(" & dayname(rsitem("menudate")) & ",""" & RSitem("menuitem") & """)")
rsitem.movenext
Loop
[/b]
'at this point we're done with the original data and using the arrays henceforth.
' so lets close and clear these buggers out
set rsitem = nothing
objconn.close
set objconn = nothing
' this next cycle is similar to the one above, and in order to conditionally check the dynamics we'll need the exec statement again in order to plug in the array names via variable into function calls, namely ubound
' this is in order to determine the max number of records returned on any given day, that way you can cycle the output out properly
MaxCount = 0
for each dayarray in dayarrays
Execute("if ubound(" & dayarray & ") > MaxCount Then MaxCount=Ubound(" & dayarray & ")")
next
' now that we have arrays populated with data, and know how big the biggest data array is, we can move on to putting it out on screen
[b]' since there were changes to the handling of things, specifically the dimming of the arrays, the first slot is no longer empty, so we'll be starting the loops at (0)
[/b]
' Lets start making output
response.write "<table border=1>" & vbcrlf
response.write "<tr>" & vbcrlf
'the vbcrlf is just for formatting in html view if you ever look at that
' writing out the column headers, the day names
for each dayarray in dayarrays
response.Write "<td>" & dayarray & "</td>" & vbcrlf
next
response.write "</tr>" & vbcrlf
Dim OutPut(0)
' Output will be a single position array to store the output for each row, just in case the data contained is larger than a string variable
'step thru all array posistions to the max
[b]For i=0 to MaxCount[/b]
' step thru each day for each array posistion step
OutPut(0) = ""
For each dayarray in dayarrays
[b]Execute("MaxRec = Ubound(" & dayarray & ")")[/b]
If i <= MaxRec Then ' catching the arrays that are smaller than the biggest one, so you dont get a "subscript out of range" error
[b] Execute("TempVal = " & dayarray & "(" & i & ")")[/b]
If TempVal <> "" Then
OutPut(0) = OutPut(0) & "<td>" & TempVal & "</td>" & vbcrlf
Else ' catches the empty ones
OutPut(0) = OutPut(0) & "<td> </td>" & vbcrlf
End If
Else
OutPut(0) = OutPut(0) & "<td> </td>" & vbcrlf
End If
Next
Response.Write "<tr>" & vbcrlf & OutPut(0) & "</tr>" & vbcrlf ' this just adds the surrounding table row tags around this row of data
Next
response.write "</table>" & vbcrlf
%>
</body>
</html>
<%
' Functions sent to bottom to free visual space
Function FindDate(DayVal,StartDate,FindBackward) ' findbackward is true/false to indicate direction from start to find first matching day
StartDate = CDate(StartDate)
If Not IsNumeric(DayVal) Then Exit Function
DayVal = CInt(DayVal)
On Error Resume Next
If FindBackward Then
For i = 1 To 8
If WeekDay(StartDate - i, vbSunday) = DayVal Then
FindDate = StartDate - i
Exit Function
End If
Next
Else
For i = 0 To 6
If WeekDay(StartDate + i, vbSunday) = DayVal Then
FindDate = StartDate + i
Exit Function
End If
Next
End If
FindDate = "Error"
End Function
Function DayName(DateValue)
If IsDate(DateValue) Then
Select Case WeekDay(DateValue, vbMonday)
Case 1
DayName = "Monday"
Case 2
DayName = "Tuesday"
Case 3
DayName = "Wednesday"
Case 4
DayName = "Thursday"
Case 5
DayName = "Friday"
Case 6
DayName = "Saturday"
Case 7
DayName = "Sunday"
End Select
Else
DayName = "Error"
End If
End Function
' function snippet from Thread333-863153
Function AddToArray(OriginArray,AddValue)
If IsArray(OriginArray) Then
NewDim = Ubound(OriginArray)+1
ReDim Preserve OriginArray(NewDim)
OriginArray(NewDim) = AddValue
AddToArray = OriginArray
Else
AddToArray = Array(OriginArray,AddValue)
End If
End Function
%>
