Hai all!
I am creating an Excel Report from ASP.
It is creating many sheets & Graphs(I have attached my coding below)
Now they uninstalled MS office from the server. So it it is giving
the following error.
"Error Type:
Microsoft VBScript runtime (0x800A01AD)
ActiveX component can't create object: 'excel.Application' "
1. Is it possible to create an Excel report from Client side.
2. If it possible means, will it take more time to create the report.
3. If it is not possible means, any other way to create the report in
ASP.(Graphs, Vertical checking etc.,)
Plz go thro' my coding and give me a better solution.
Thanx in advance
Seetha
<%@ Language=VBScript%>
<%Response.ContentType = "application/vnd.ms-excel"
Response.Buffer = True
server.ScriptTimeout=800%>
<HTML>
<HEAD>
<!--#include file="Conn.asp"-->
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
</HEAD>
<BODY bgcolor="AliceBlue" onload="closepage()">
<%
dim objtools
Set objtools=Server.CreateObject("ASPFormat.Class1")
Set xlapp = CreateObject("excel.Application")
xlapp.Application.Visible = True
Set xlBk = xlapp.Workbooks.Add
set xlsht=xlbk.Worksheets(1)
Sql = "SELECT pcode FROM projectdetail group by pcode"
set rs=Server.CreateObject("ADODB.recordset")
rs.Open Sql, conn
xlsht.Cells(1, 1) = "Project Wise"
xlsht.Range("a1").Font.Bold = True
xlsht.Range("a1").Font.Size = 16
r = 3
While Not rs.EOF
prj = rs.Fields(0).Value
m = 2
r = r + 1
xlsht.Cells(r, 1) = "Project Name : " & prj
xlsht.Cells(r,1).Interior.colorIndex=6
xlsht.Cells(r,1).font.bold=true
xlsht.Cells(r,1).Font.Size = 16
xlsht.Cells(r,2).Interior.colorIndex=6
xlsht.Cells(r,2).font.bold=true
xlsht.Cells(r,2).Font.Size = 16
xlsht.Cells(r,3).Interior.colorIndex=6
xlsht.Cells(r,3).font.bold=true
xlsht.Cells(r,3).Font.Size = 16
xlsht.Cells(r,4).Interior.colorIndex=6
xlsht.Cells(r,4).font.bold=true
xlsht.Cells(r,4).Font.Size = 16
r = r + 2
a = "d" & r
b = "iv" & r
xlsht.Range(a, b).NumberFormat = "mmm-yyyy"
'xlsht.Range("d5:iv5").NumberFormat = "mmm-yy"
xlsht.Cells(r,1).Interior.colorIndex=9
xlsht.Cells(r,1).font.colorIndex=6
xlsht.Cells(r,1).font.bold=true
xlsht.Cells(r, 1) = "Department"
xlsht.Cells(r,2).Interior.colorIndex=9
xlsht.Cells(r,2).font.colorIndex=6
xlsht.Cells(r,2).font.bold=true
xlsht.Cells(r, 2) = "Section"
xlsht.Cells(r, 3) = "Month"
xlsht.Cells(r,3).Interior.colorIndex=15
xlsht.Cells(r,3).font.colorIndex=1
xlsht.Cells(r,3).font.bold=2
dt = Date
mn = 4
r3=r
For i = 1 To 36
a = DateAdd("m", i - 1, dt)
xlsht.Cells(r, mn) = a
xlsht.Cells(r,mn).Interior.colorIndex=15
xlsht.Cells(r,mn).font.colorIndex=1
xlsht.Cells(r ,mn).font.bold=true
mn = mn + 1
Next
r = r + 1
set rs2=Server.CreateObject("ADODB.recordset")
sql2 = "select dept,[section] from department group by dept,[section]"
rs2.Open sql2, conn
Do While Not rs2.EOF
dp1 = rs2.Fields(0).Value
st1 = rs2.Fields(1).Value
xlsht.Cells(r, 1) = dp1
xlsht.Cells(r, 2) = st1
xlsht.Cells(r,1).Interior.colorIndex=9
xlsht.Cells(r,1).font.colorIndex=6
xlsht.Cells(r,1).font.bold=true
xlsht.Cells(r,2).Interior.colorIndex=9
xlsht.Cells(r,2).font.colorIndex=6
xlsht.Cells(r,2).font.bold=true
set rs1=Server.CreateObject("ADODB.recordset")
sql1 = "SELECT * FROM projectavailability where pcode='" & prj & "'
and dept='" & dp1 & "' and [section]='" & st1 & "'"
rs1.Open sql1, conn
If Not (rs1.EOF = True And rs1.BOF = True) Then
r1 = r
xlsht.Cells(r, 3) = "Milestones"
xlsht.Cells(r,3).Interior.colorIndex=15
xlsht.Cells(r,3).font.colorIndex=1
xlsht.Cells(r,3).font.bold=true
xlsht.Cells(r + 1, 3) = "Required"
xlsht.Cells(r + 1,3).Interior.colorIndex=15
xlsht.Cells(r + 1,3).font.colorIndex=1
xlsht.Cells(r + 1,3).font.bold=true
xlsht.Cells(r + 2, 3) = "Availability"
xlsht.Cells(r + 2,3).Interior.colorIndex=15
xlsht.Cells(r + 2,3).font.colorIndex=1
xlsht.Cells(r + 2,3).font.bold=true
xlsht.Cells(r + 3, 3) = "Gap >>>"
xlsht.Cells(r + 3, 3).Interior.colorIndex=15
xlsht.Cells(r + 3, 3).font.colorIndex=1
xlsht.Cells(r + 3, 3).font.bold=true
xlsht.Cells(r + 4, 3) = "Availability"
xlsht.Cells(r + 4, 3).Interior.colorIndex=15
xlsht.Cells(r + 4, 3).font.colorIndex=1
xlsht.Cells(r + 4, 3).font.bold=true
Do While Not rs1.EOF
For m = 4 To 40
mth1 = objtools.FormatString(xlsht.Cells(6, m), "mmm-yyyy")
set rs4=Server.CreateObject("ADODB.recordset")
sql4 = "select max(baselineno) from projectmilestones where pcode='"
& prj & "'"
rs4.Open sql4, conn
if not (rs4.EOF=true and rs4.BOF=true) then
mxb=rs4.Fields(0).Value
else
mxb=1
end if
rs4.Close
set rs3=Server.CreateObject("ADODB.recordset")
sql3 = "select * from projectmilestones where pcode='" & prj & "' and
baselineno=" & mxb
rs3.Open sql3, conn
If Not (rs3.EOF = True And rs3.BOF = True) Then
mph = ""
Do While Not rs3.EOF
sm = rs3.Fields(2).Value
em = rs3.Fields(3).Value
flag = 0
For j = sm To em
my1 = ""
m1 = objtools.FormatString(j, "mmm-yyyy")
If m1 = mth1 Then
flag = 1
Exit For
End If
Next
If flag = 1 Then
If mph = "" Then
mph = rs3.Fields(1).Value
Else
mph = mph & "," & rs3.Fields(1).Value
End If
End If
rs3.MoveNext
Loop
xlsht.Cells(r, m) = mph
xlsht.Cells(r,m).Interior.colorIndex=36
End If
mth2=objtools.FormatString(rs1.Fields(1).Value,"mmm-yyyy")
mt=rs1.Fields(1).Value
reqmth=month(mt)
reqyear=year(mt)
If mth1 = mth2 Then
xlsht.Cells(r + 1, m) = rs1.Fields(4).Value
a=0
set rs5=Server.CreateObject("ADODB.recordset")
sql5 = "SELECT availno FROM availabilityno where (pcode='" & prj & "'
and dept='" & dp1 & "' and [section]='" & st1 & "' and month(pmonth)
=" & reqmth & " and year(pmonth)=" & reqyear & ")"
rs5.Open sql5, conn
if not (rs5.EOF=true and rs5.BOF=true) then
'mth3=objtools.FormatString(rs5.Fields(0).Value,"mmm-yyyy")
'if mth1=mth3 then
a=rs5.Fields(0).Value
'end if
end if
xlsht.Cells(r + 2, m) = a
g=rs1.Fields(4).Value - a
if g<0 then
xlsht.Cells(r + 3, m) = 0
xlsht.cells(r + 1, m) = a
else
xlsht.Cells(r + 3, m) = g
end if
if rs1.Fields(6).Value>0 then
xlsht.Cells(r + 3,m).Interior.colorIndex=40
else
xlsht.Cells(r + 3,m).Interior.colorIndex=35
end if
if xlsht.cells(r+1,m)=0 then
else
xlsht.Cells(r + 4, m) = round((xlsht.cells(r+2,m) /xlsht.cells
(r+1,m)) * 100) & "%"
end if
xlsht.Cells(r + 4, m).Interior.colorIndex=34
End If
Next
rs1.MoveNext
Loop
fst="C" & r3
est="AM" & r3
fst1="C" & r1
est1= "AM" & r + 3
rge=fst & ":" & est & "," & fst1 & ":" & est1
xlapp.Charts.Add
xlapp.ActiveChart.PlotArea.Interior.ColorIndex=19
xlapp.ActiveChart.ChartType=65
xlapp.ActiveChart.SetSourceData xlbk.Worksheets(1).Range(rge),1
xlapp.ActiveChart.HasTitle=True
xlapp.ActiveChart.ChartTitle.Text="Resources [" & prj & "]," &st1
& ", " & dp1
xlapp.ActiveChart.ApplyDataLabels
xlapp.ActiveChart.PlotArea.Interior.ColorIndex=2
xlapp.ActiveChart.SeriesCollection(2).Border.ColorIndex=5
xlapp.ActiveChart.SeriesCollection(2).MarkerBackgroundColorIndex=5
xlapp.ActiveChart.SeriesCollection(2).MarkerForegroundColorIndex=5
xlapp.ActiveChart.SeriesCollection(3).Border.ColorIndex=50
xlapp.ActiveChart.SeriesCollection(3).MarkerBackgroundColorIndex=50
xlapp.ActiveChart.SeriesCollection(3).MarkerForegroundColorIndex=50
xlapp.ActiveChart.SeriesCollection(4).Border.ColorIndex=3
xlapp.ActiveChart.SeriesCollection(4).MarkerBackgroundColorIndex=3
xlapp.ActiveChart.SeriesCollection(4).MarkerForegroundColorIndex=3
r = r + 5
End If
rs1.Close
rs2.MoveNext
Loop
rs.MoveNext
Wend
set objtools=NOTHING
sfilename="c:\projectwise.xls"
xlbk.SaveAs sfilename
xlApp.Application.Quit
Set xlApp = Nothing
set rs=Server.CreateObject("ADODB.Stream")
rs.Type = 1
rs.Open
rs.LoadFromFile sfilename
Dim lstrFileName
lstrFileName = "projectwise"
Response.AddHeader "Content-Disposition", "attachment;
filename= " & lstrFileName & ".xls"
Response.AddHeader "Content-type","application/vnd.ms-excel"
Response.Clear()
Response.BinaryWrite (rs.Read(rs.Size))
set fso=Server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile sfilename,true
%>
</BODY>
</HTML>
------------------------ Yahoo! Groups Sponsor --------------------~-->
Make a clean sweep of pop-up ads. Yahoo! Companion Toolbar.
Now with Pop-Up Blocker. Get it for free!
http://us.click.yahoo.com/L5YrjA/eSIIAA/yQLSAA/saFolB/TM
--------------------------------------------------------------------~->
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/AspClassicAnyQuestionIsOk/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
