Welcome to The RocketMan.com

Gotta Event to Add??

<% Function GetDaysInMonth(iMonth, iYear) Dim dTemp dTemp = DateAdd("d", -1, DateSerial(iYear, iMonth + 1, 1)) GetDaysInMonth = Day(dTemp) End Function Function GetWeekdayMonthStartsOn(dAnyDayInTheMonth) Dim dTemp dTemp = DateAdd("d", -(Day(dAnyDayInTheMonth) - 1), dAnyDayInTheMonth) GetWeekdayMonthStartsOn = WeekDay(dTemp) End Function Function SubtractOneMonth(dDate) SubtractOneMonth = DateAdd("m", -1, dDate) End Function Function AddOneMonth(dDate) AddOneMonth = DateAdd("m", 1, dDate) End Function Dim dDate Dim iDIM Dim iDOW Dim iCurrent Dim iPosition If IsDate(Request.QueryString("date")) Then dDate = CDate(Request.QueryString("date")) Else If IsDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Then dDate = CDate(Request.QueryString("month") & "-" & Request.QueryString("day") & "-" & Request.QueryString("year")) Else dDate = Date() If Len(Request.QueryString("month")) <> 0 Or Len(Request.QueryString("day")) <> 0 Or Len(Request.QueryString("year")) <> 0 Or Len(Request.QueryString("date")) <> 0 Then Response.Write "The date you picked was not a valid date. The calendar was set to today's date.

" End If End If End If iDIM = GetDaysInMonth(Month(dDate), Year(dDate)) iDOW = GetWeekdayMonthStartsOn(dDate) %> <% ' Write spacer cells at beginning of first row if month doesn't start on a Sunday. If iDOW <> 1 Then Response.Write vbTab & "" & vbCrLf iPosition = 1 Do While iPosition < iDOW Response.Write vbTab & vbTab & "" & vbCrLf iPosition = iPosition + 1 Loop End If Dim adoCon, objRS, objRSD, adoConD Dim rs Dim sql, sqlDate Set adoCon2 = Server.CreateObject("ADODB.Connection") adoCon2.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("rockdb/rocketdatb.mdb") & ";" 'sqlDate = "DELETE FROM calendar WHERE EventDate < #" & dDate & "#" 'Set objRSD = adoCon.Execute(sqlDate) 'If Err <> 0 Then ' Response.Write("Sorry, the connection to the database failed, please try again in a few minutes.") ' Response.Write Err.Description 'Else 'Response.Write("Previous Dates have been deleted!") 'adoConD.close 'Set adoConD = Nothing ' Set objRSD = Nothing 'End If 'Response.Write cDate(dDate) sql = "SELECT * FROM calendar WHERE EventDate LIKE '" & Month(dDate) & "%' ORDER BY EventDate" 'Response.Write sql Set objRSd = adoCon2.Execute(sql) ' Write days of month in proper day slots iCurrent = 1 iPosition = iDOW Do While iCurrent <= iDIM ' If we're at the begginning of a row then write TR If iPosition = 1 Then Response.Write vbTab & "" & vbCrLf End If Do Until objRSd.EOF strDates = objRSd("EventDate") 'reDim D(0) 'Response.Write strDates & "
" arrayD = split(strDates, "/") 'Response.Write arrayD(1) & " " & arrayD(0) & " " & arrayD(2) & "
" 'Response.Write iCurrent ' If the day we're writing is the selected day then highlight it somehow. If iCurrent = cInt(arrayD(1)) And cInt(arrayD(0)) = Month(dDate) And cInt(arrayD(2)) = Year(dDate) And iCurrent = Day(dDate) Then Response.Write vbTab & vbTab & "" & vbCrLf If iPosition = 7 Then Response.Write vbTab & "" & vbCrLf iPosition = 0 End If ' Increment variables iCurrent = iCurrent + 1 iPosition = iPosition + 1 ElseIf iCurrent = cInt(arrayD(1)) And cInt(arrayD(0)) = Month(dDate) And cInt(arrayD(2)) = Year(dDate) Then Response.Write vbTab & vbTab & "" & vbCrLf If iPosition = 7 Then Response.Write vbTab & "" & vbCrLf iPosition = 0 End If ' Increment variables iCurrent = iCurrent + 1 iPosition = iPosition + 1 'Exit Do End If objRSd.MoveNext Loop objRSd.close objRSd.open If iCurrent = Day(dDate) Then Response.Write vbTab & vbTab & "" & vbCrLf Else Response.Write vbTab & vbTab & "" & vbCrLf End If ' If we're at the endof a row then write /TR If iPosition = 7 Then Response.Write vbTab & "" & vbCrLf iPosition = 0 End If ' Increment variables iCurrent = iCurrent + 1 iPosition = iPosition + 1 Loop objRSd.close Set objRSd = Nothing Set adoCon2 = Nothing 'Write spacer cells at end of last row if month doesn't end on a Saturday. If iPosition <> 1 Then Do While iPosition <= 7 Response.Write vbTab & vbTab & "" & vbCrLf iPosition = iPosition + 1 Loop Response.Write vbTab & "" & vbCrLf End If %>

<< <%= MonthName(Month(dDate)) & " " & Year(dDate) %> >>
S	M	T	W	T	F	S

" & iCurrent & "
" & iCurrent & "
" & iCurrent & "	" & iCurrent & "

Activities for:
<%= MonthName(Month(dDate)) & " " & Day(dDate) & ", " & Year(dDate) %>

<% Set adoCon = Server.CreateObject("ADODB.Connection") adoCon.Open "DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & Server.MapPath("rockdb/rocketdatb.mdb") & ";" 'sqlDate = "DELETE FROM calendar WHERE EventDate < #" & dDate & "#" 'Set objRSD = adoCon.Execute(sqlDate) 'If Err <> 0 Then ' Response.Write("Sorry, the connection to the database failed, please try again in a few minutes.") ' Response.Write Err.Description 'Else 'Response.Write("Previous Dates have been deleted!") 'adoConD.close 'Set adoConD = Nothing ' Set objRSD = Nothing 'End If 'Response.Write cDate(dDate) sql = "SELECT * FROM calendar WHERE EventDate = #" & cDate(dDate) & "#" Set objRS = adoCon.Execute(sql) 'Response.Write sql If Err <> 0 Then Response.Write("Sorry, the connection to the database failed, please try again in a few minutes.") Response.Write Err.Description Else If objRS.EOF Then Response.Write "

No events for this date.
Check back soon!!

" Else While Not objRS.EOF Response.Write "

" & objRS("Event") & "
" Response.Write objRS("Place") & "

" Response.Write objRS("Comments") & "

" ' Response.Write "" & objRS("Date") & dDate & "
" objRS.MoveNext Wend End If End If objRS.close adoCon.close Set adoCon = Nothing %>