RE: Adding filters to excel report

[chandhseke]

Hi folks,

I am a newbie to this functionality of creating excel report using VB/VB Script.
I have been given a code and asked to add filters to the excel sheet that is created using the below code.

Can somebody help me out in resloving the issue??

<%
Option Explicit
%>
<!--#include file="connection.asp"-->//DB connection string
<%
Dim sqlstr
Dim oConn,sql,rs,HeaderTitle,dDateNow,sDateString,sFil eName

Const PAGE_TITLE = "Contract Database Reporting"

'download to excel
'setup filename
dDateNow = Now
sDateString = CStr(Month(dDateNow)) & CStr(Day(dDateNow)) & CStr(Year(dDateNow)) & CStr(Hour(dDateNow)) & CStr(Minute(dDateNow))

sqlstr = Trim(Request.Form("SQL"))

sFileName = "ContractDB_datadump_" & sDateString & ".xls"

sql = sqlstr
'db oConnection and query

if Request.QueryString("Pref") = "Yes" then
sql = "SELECT Datecreated,Ref_Num,Record_Status,Agr_Model,Suppli erRating,SupType,Company_Name,Com_Group,Com_Code,P referredGeography,PreferredCountries,Proc_Email,St art_Date,End_Date FROM Sample WHERE Record_Status = 'Active' AND SupplierRating LIKE 'Preferred%' Order by Company_Name Asc"
end if

Set rs = Server.CreateObject("ADODB.Recordset")
Set rs = oConn.Execute(sql)

'call rs to excel function
Call DisplayRSInExcel(rs,"#CC0033","#FFFFFF",sFileName)
'cleanup
rs.Close
Set rs = Nothing
oConn.Close
Set oConn = Nothing

'-------------routines used in this page --------------------------------------------------------
'function display RS in excel format in browser
Sub DisplayRSInExcel(oRs,sHeaderBGColor,sHeaderFontCol or,sFilename)
Dim m, i 'number of fields, loop variable
Dim s1, s2 'work strings
Dim sCellValue
Dim sCellBGColor
Dim objExcel
Dim objMailName
'Dim sFieldVal
Dim s_RetVal

'excel header info
Response.Buffer = True
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader "Content-Disposition", "attachment; filename=" & sFilename

If oRs.EOF Then
Response.Write "No records match your request" & vbcrlf
Else
if Request.QueryString("Pref") = "Yes" then

'create table & header cells (and border if desired)
Response.Write "<table cellpadding=""0"" cellspacing=""0"" border=""1"">" & vbcrlf & "<tr>" & vbcrlf

'create header
m = oRs.Fields.Count - 1
For i = 0 To 13

s1 = oRs.Fields(i).Name & ""
s2 = replace(s1, "_", " ")
Response.Write "<td align=""left"" valign=""top"" bgcolor=""" & sHeaderBGColor & """><b><font color=""" & sHeaderFontColor & """>" & s2 & "</font></b></td>"
Next
Response.Write "</tr>" & vbcrlf & vbcrlf

'create detail records
Do While Not oRs.EOF
Response.Write "<tr>"
For i = 0 To 13
sCellValue = oRs.Fields(i).Value

If IsNull(sCellValue) Then sCellValue = ""
sCellBGColor = ""
Next
Response.Write "</tr>" & vbcrlf
oRs.MoveNext
Loop
Response.Write "</table>" & vbcrlf

Else

'create table & header cells (and border if desired)
Response.Write "<table cellpadding=""0"" cellspacing=""0"" border=""1"">" & vbcrlf & "<tr>" & vbcrlf

'create header
m = oRs.Fields.Count - 1

For i = 0 To 26

s1 = oRs.Fields(i).Name & ""

If s1 = "ReqState" Then
Else
s2 = replace(s1, "_", " ")
Response.Write "<td align=""left"" valign=""top"" bgcolor=""" & sHeaderBGColor & """><b><font color=""" & sHeaderFontColor & """>" & s2 & "</font></b></td>"
End If
Next
Response.Write "</tr>" & vbcrlf & vbcrlf

'create detail records
Do While Not oRs.EOF
Response.Write "<tr>"
For i = 0 To 26
sCellValue = oRs.Fields(i).Value

If oRs.Fields(i).Name = "ReqState" Then
Else

If IsNull(sCellValue) Then sCellValue = ""
sCellBGColor = ""

Response.Write "<td " & sCellBGColor & ">" & sCellValue & "</td>"

End If
Next
Response.Write "</tr>" & vbcrlf
oRs.MoveNext
Loop
Response.Write "</table>" & vbcrlf

End If

End If

End Sub
%>

Thanks in advance.

Regards,
Chandhseke

[chandhseke]

P.S I want to add filters to the excel sheet that gets generated using the above code. Please help