%
'dim funcs
set funcs = New clsFUNC
dim strDates
dim RS
select case request("View")
case "Day" strDates = " AND wcal_eventrec.EventDate = " & funcs.VDate(request("Q_DATE"))
case "Week" strDates = " AND wcal_eventrec.EventDate >= " & funcs.VDate(request("Q_DATE")) & " AND wcal_eventrec.EventDate <= " & funcs.VDate(DateAdd("W",1,request("Q_DATE")))
case "Month" strDates = " AND wcal_eventrec.EventDate >= " & funcs.VDate(request("Q_DATE")) & " AND wcal_eventrec.EventDate <= " & funcs.VDate(DateAdd("m",1,request("Q_DATE")))
case else strDates = ""
end select
select case dbType
case "MSACCESS", "MSSQL"
StrSql = "SELECT wcal_events.IDEvent, wcal_events.EventName, wcal_events.Description, wcal_events.Place, wcal_events.URLLink, wcal_events.ContactEmail, wcal_events.ContactEmailDesc, wcal_eventrec.EventDate, wcal_eventrec.StartTime, wcal_eventrec.EndTime, wcal_category.Name FROM (wcal_eventcat LEFT JOIN (wcal_events LEFT JOIN wcal_eventrec ON wcal_events.IDEvent = wcal_eventrec.IDEvent) ON wcal_eventcat.IDEvent = wcal_events.IDEvent) INNER JOIN wcal_category ON wcal_eventcat.IDCat = wcal_category.IDCat where (UserPrivate=0 OR UserPrivate=" & session("WCAL_USERID") & ") AND wcal_eventrec.Lang=" & session("Lang") & " and wcal_eventrec.Client=" & session("Client") & strDates
case else
StrSql = "SELECT wcal_events.IDEvent, wcal_events.EventName, wcal_events.Description, wcal_events.Place, wcal_events.URLLink, wcal_events.ContactEmail, wcal_events.ContactEmailDesc, wcal_eventrec.EventDate, wcal_eventrec.StartTime, wcal_eventrec.EndTime, wcal_category.Name FROM wcal_eventcat LEFT JOIN wcal_events ON wcal_eventcat.IDEvent = wcal_events.IDEvent LEFT JOIN wcal_eventrec ON wcal_events.IDEvent = wcal_eventrec.IDEvent LEFT JOIN wcal_category ON wcal_eventcat.IDCat = wcal_category.IDCat where (UserPrivate=0 OR UserPrivate=" & session("WCAL_USERID") & ") AND wcal_eventrec.Lang=" & session("Lang") & " and wcal_eventrec.Client=" & session("Client") & strDates
end select
if session("wcal_cat") <> "" then StrSql = strSQL & " AND wcal_category.Name like '" & session("wcal_cat") & "'"
if session("wcal_loc") <> "" then strSQL = strSQL & " AND wcal_events.Place like '%" & session("wcal_loc") & "%'"
' if session("wcal_pers") <> "" then strSQL = strSQL & " AND wcal_events.Person = '" & session("wcal_pers") & "'"
On Error Resume Next
dim dba, rec, s, fld
dim DlmColumn, DlmRow, DlmText
set con = Server.CreateObject("ADODB.Connection")
con.Open strConnect
Set rec = Con.Execute (StrSql)
Randomize
Response.ContentType ="Application/vnd.excel"
Response.AddHeader "Content-Disposition", "attachment; filename=Excel" & Int((Rnd() * 10000000)) & ".xls"
'Display a table using GETROWS, very fast!
' Declare our variables... always good practice!
DIM MySQL
Dim rstGetRows ' ADO recordset
Dim arrDBData ' Array that we dump all the data into
'Temp vars to speed up looping over the array
Dim I, J
Dim iRecFirst, iRecLast, Field
Dim iFieldFirst, iFieldLast, intRecordCount
'Set rstGetRows = cnnGetRows.Execute(MySQL)
Set rstGetRows = con.Execute(strSQL)
If rstGetRows.eof then
response.write "No records matched
"
response.write mySQL & "
So cannot make table..."
rstGetRows.Close
Set rstGetRows = Nothing
con.Close
Set conn = Nothing
response.end
end if
arrDBData = rstGetRows.GetRows()
'Find the Upper & Lower ends of the Array
iRecFirst = LBound(arrDBData, 2)
iRecLast = UBound(arrDBData, 2)
iFieldFirst = LBound(arrDBData, 1)
iFieldLast = UBound(arrDBData, 1)
intRecordCount = UBound(arrDBData, 2) + 1
Response.Write "
| " & Field.Name & " | " & vbCrLf Next 'Field Response.Write vbTab & "
|---|
| " & arrDBData(J, I) & " | " & vbCrLf Next ' J Response.Write vbTab & "