T
Trieu Anh Dung
My ASP web application query data from SQL Server 2000 and export to EXCEL
files.
Here is my code:
<%@ Language=VBScript %>
<%Option Explicit
Response.Buffer = true
%>
<!-- #include file="checksecurity.asp" -->
<!-- #include file="msgconst.asp" -->
<!-- #include file="connectdb.asp" -->
<!-- #include file="toc.asp" -->
<!-- #include file="error-lib.asp" -->
<!-- #include file="navigator.asp" -->
<!-- #include file="interfacelib.asp" -->
<%
Sub Initialize()
Dim strExFieldList, strExFromTables, strExWhere, strExSort, strExKey,
intExPage, intExRows
'Lay du lieu dau vao tu Request
strExFieldList =Request("FieldList")
strExFromTables=Request("FromTables")
strExWhere=Request("Where")
strExSort=Request("Sort")
'Xay dung cau lenh lay du lieu loi tu bang Error va Status
Dim strSQL, rstData, intTotalPages, intTotalRows
Set rstData = Server.CreateObject("ADODB.RecordSet")
strSQL = " SELECT A.Name As IssueName, A.Description, A.RaisedTo,
A.[Date], B.Name As Status FROM " & strExFromTables & " WHERE " &
strExWhere & " ORDER BY " & strExSort
'Response.Write strSQL & "<BR>"
'Ket noi CSDL
Dim objConnection
Call OpenConnection(objConnection)
if Not(objConnection is nothing) then
'Query du lieu
rstData.CursorLocation = 3
rstData.Open strSql,objConnection
'Chuan bi bang du lieu
ReDim arrData(1,1)
Dim iCount
ReDim arrData(rstData.RecordCount*2,5)
iCount = 0
'Response.Write "Getting " & rstData.RecordCount & " record(s) "
do while not rstData.EOF
arrData(iCount*2,0) = iCount + 1
arrData(iCount*2,1) = Literal2Unicode(rstData("IssueName"))
arrData(iCount*2,2) = rstData("RaisedTo")
arrData(iCount*2,3) = rstData("Date")
arrData(iCount*2,4) = Literal2Unicode(rstData("Status"))
arrData(iCount*2+1,1) = Literal2Unicode(rstData("Description"))
rstData.MoveNext
Response.Write "."
iCount = iCount + 1
loop
rstData.Close
set rstData = nothing
'Lay thu muc ghi file
Dim strAttPath, strDestPath
strAttPath = Server.MapPath("./.") & "\" & ATTACHMENTS_FOLDER & "\"
strDestPath = strAttPath & Session("CompanyCode") & "\"
'Kiem tra thu muc
Dim objFSO, objFolder
Dim objUploader, strNewFile, strNewFolder
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if Not(objFSO.FolderExists(strDestPath)) then
Set objFolder = objFSO.CreateFolder(strDestPath)
end if
if Err.number<>0 then exit sub
'Xuat ra excel
'Kiem tra file template
Dim strTemplateFileName
strTemplateFileName = "TrkTemplate.xls"
Dim oExcel,oBook,oSheet
Set oExcel = CreateObject("Excel.Application")
if objFSO.FileExists(strAttPath & strTemplateFileName) then
Set oBook = oExcel.Workbooks.Open(strAttPath & strTemplateFileName)
else
Set oBook = oExcel.Workbooks.Add
end if
'Get the first worksheet in the workbook so that you can
'make changes to it
Set oSheet = oBook.Worksheets(1)
'Response.Write "<BR>Ubound=" & UBound(arrData,1)
oSheet.Range(oSheet.Cells(5,1),oSheet.Cells(UBound(arrData,1)+5,5)).Text
=
arrData
oSheet.Range("A1").Value = "Report date: " & Now()
'Sinh ten file
Dim strExFileName
strExFileName = "Report" & Session.SessionID & Hour(Now()) &
Minute(Now())
& Second(Now()) & ".xls"
'Response.Write "<BR>" & strExFileName & "<BR>"
oBook.SaveAs strDestPath & strExFileName
oBook.Close true
oExcel.Quit
Set oBook = Nothing
Set oExcel = Nothing
' Response.Write "Genarate complete!"
'Sinh code HTML de nguoi dung download file ket qua
call DisplayPage(strExFileName,true,"")
end if
Call CloseConnection(objConnection)
End Sub
<%call Initialize()%>
it runs smoothly with 3000 records of category "A" but it failed with just
135 records of category "B" with some specific unicode data. I always get
"Out of memory" error at line 90:
oSheet.Range(oSheet.Cells(5,1),oSheet.Cells(UBound(arrData,1)+5,5)).Text =
arrData
I'm sure that the memory is enough to store all the data. Please help me to
fix this error.
Thanks for reading
files.
Here is my code:
<%@ Language=VBScript %>
<%Option Explicit
Response.Buffer = true
%>
<!-- #include file="checksecurity.asp" -->
<!-- #include file="msgconst.asp" -->
<!-- #include file="connectdb.asp" -->
<!-- #include file="toc.asp" -->
<!-- #include file="error-lib.asp" -->
<!-- #include file="navigator.asp" -->
<!-- #include file="interfacelib.asp" -->
<%
Sub Initialize()
Dim strExFieldList, strExFromTables, strExWhere, strExSort, strExKey,
intExPage, intExRows
'Lay du lieu dau vao tu Request
strExFieldList =Request("FieldList")
strExFromTables=Request("FromTables")
strExWhere=Request("Where")
strExSort=Request("Sort")
'Xay dung cau lenh lay du lieu loi tu bang Error va Status
Dim strSQL, rstData, intTotalPages, intTotalRows
Set rstData = Server.CreateObject("ADODB.RecordSet")
strSQL = " SELECT A.Name As IssueName, A.Description, A.RaisedTo,
A.[Date], B.Name As Status FROM " & strExFromTables & " WHERE " &
strExWhere & " ORDER BY " & strExSort
'Response.Write strSQL & "<BR>"
'Ket noi CSDL
Dim objConnection
Call OpenConnection(objConnection)
if Not(objConnection is nothing) then
'Query du lieu
rstData.CursorLocation = 3
rstData.Open strSql,objConnection
'Chuan bi bang du lieu
ReDim arrData(1,1)
Dim iCount
ReDim arrData(rstData.RecordCount*2,5)
iCount = 0
'Response.Write "Getting " & rstData.RecordCount & " record(s) "
do while not rstData.EOF
arrData(iCount*2,0) = iCount + 1
arrData(iCount*2,1) = Literal2Unicode(rstData("IssueName"))
arrData(iCount*2,2) = rstData("RaisedTo")
arrData(iCount*2,3) = rstData("Date")
arrData(iCount*2,4) = Literal2Unicode(rstData("Status"))
arrData(iCount*2+1,1) = Literal2Unicode(rstData("Description"))
rstData.MoveNext
Response.Write "."
iCount = iCount + 1
loop
rstData.Close
set rstData = nothing
'Lay thu muc ghi file
Dim strAttPath, strDestPath
strAttPath = Server.MapPath("./.") & "\" & ATTACHMENTS_FOLDER & "\"
strDestPath = strAttPath & Session("CompanyCode") & "\"
'Kiem tra thu muc
Dim objFSO, objFolder
Dim objUploader, strNewFile, strNewFolder
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
if Not(objFSO.FolderExists(strDestPath)) then
Set objFolder = objFSO.CreateFolder(strDestPath)
end if
if Err.number<>0 then exit sub
'Xuat ra excel
'Kiem tra file template
Dim strTemplateFileName
strTemplateFileName = "TrkTemplate.xls"
Dim oExcel,oBook,oSheet
Set oExcel = CreateObject("Excel.Application")
if objFSO.FileExists(strAttPath & strTemplateFileName) then
Set oBook = oExcel.Workbooks.Open(strAttPath & strTemplateFileName)
else
Set oBook = oExcel.Workbooks.Add
end if
'Get the first worksheet in the workbook so that you can
'make changes to it
Set oSheet = oBook.Worksheets(1)
'Response.Write "<BR>Ubound=" & UBound(arrData,1)
oSheet.Range(oSheet.Cells(5,1),oSheet.Cells(UBound(arrData,1)+5,5)).Text
=
arrData
oSheet.Range("A1").Value = "Report date: " & Now()
'Sinh ten file
Dim strExFileName
strExFileName = "Report" & Session.SessionID & Hour(Now()) &
Minute(Now())
& Second(Now()) & ".xls"
'Response.Write "<BR>" & strExFileName & "<BR>"
oBook.SaveAs strDestPath & strExFileName
oBook.Close true
oExcel.Quit
Set oBook = Nothing
Set oExcel = Nothing
' Response.Write "Genarate complete!"
'Sinh code HTML de nguoi dung download file ket qua
call DisplayPage(strExFileName,true,"")
end if
Call CloseConnection(objConnection)
End Sub
<%call Initialize()%>
it runs smoothly with 3000 records of category "A" but it failed with just
135 records of category "B" with some specific unicode data. I always get
"Out of memory" error at line 90:
oSheet.Range(oSheet.Cells(5,1),oSheet.Cells(UBound(arrData,1)+5,5)).Text =
arrData
I'm sure that the memory is enough to store all the data. Please help me to
fix this error.
Thanks for reading