ASP页面将数据库中检索数据生成到本地报表的解决方案

本文介绍如何在ASP中将数据库检索数据导出为CSV文件,再利用Excel模板生成报表供用户下载。通过清除服务器上旧的CSV和Excel文件,创建CSV数据,然后使用Excel的VBA宏将CSV数据读入模板生成报表。
摘要由CSDN通过智能技术生成

 Web系统的开发过程中,我们经常会碰到一些这样的需求。客户要求将DB检索出的数据导出,并下载到本地的Excel文件中,做成一定样式的报表。这里我想通过一个实际的例子,讲讲我们是如何在ASP中实现这一需求的。 

  

一、下载处理中,CSV文件生成和Excel模板拷贝的实现代码如下:

 1、上图为数据检索页面,检索的数据一览显示。并且在该页面中将检索用的sql文保存在
Session("strEXCELSQL")中。

2、点击Excel export按钮,提交到下面的下载页面。


3、现在页面重新进行数据库检索,生成CSV数据文件。代码如下:
<%
‘变量定义
Dim fso, Fld, delf, tmpf, fmd, today

‘创建文件处理对象
set fso = CreateObject("Scripting.FileSystemObject")
‘对应web服务器csv目录
set Fld = fso.GetFolder(Server.MapPath("csv"))
set delf = Fld.Files
‘将web服务器csv目录中当天以前的所有文件删除。
For Each tmpf in delf
 fmd = tmpf.DateLastModified
 today = date()
 if(year(fmd) < year(today)) then
  tmpf.delete
 elseif(month(fmd) < month(today)) then
  tmpf.delete
 elseif(day(fmd) < day(today)) then
  tmpf.delete
 end if
next
‘对应web服务器Excel下载目录
set Fld = fso.GetFolder(Server.MapPath("excel_download/"))
set delf = Fld.Files
‘将web服务器Excel下载目录中当天以前的所有文件删除。
For Each tmpf in delf
 fmd = tmpf.DateLastModified
 today = date()
 if(year(fmd) < year(today)) then
  tmpf.delete
 elseif(month(fmd) < month(today)) then
  tmpf.delete
 elseif(day(fmd) < day(today)) then
  tmpf.delete
 end if
next

‘变量定义
Dim rsPtn, strTitle, PtnNo
Dim rsData
Dim rsData_numRows
Dim csvFilePath, strFileNm
Dim strSelectSQL
Dim tempof, f1, csvfile
Dim csvLine, lngLineCnt
Dim i
Dim nowTime, strH, strM, strS
Dim strDateBuf
Dim strCol
Dim strOwner

‘当前时间的取得
nowTime = Time()
strH = Hour(nowTime)
if(0 <= strH and strH <= 9) then
 strH = "0" & CStr(strH)
end if
strM = Minute(nowTime)
if(0 <= strM and strM <= 9) then
 strM = "0" & CStr(strM)
end if
strS = Second(nowTime)
if(0 <= strS and strS <= 9) then
 strS = "0" & CStr(strS)
end if

‘检索页面设定的SQL文取得
strSelectSQL = Session("strEXCELSQL")
‘数据库访问
Set rsData = Server.CreateObject("ADODB.Recordset")
rsData.ActiveConnection = CONNECT_STRING
rsData.Source = strSelectSQL
rsData.CursorType = 0
rsData.CursorLocation = 2
rsData.LockType = 1
rsData.Open()
rsData_numRows = 0
‘CSV文件名生成‘Excel_ +用户ID+时+分+秒
strFileNm = "Excel_" & Session.SessionID & strH & strM & strS
csvFilePath = Server.MapPath("csv") & "/" & strFileNm & ".csv"
‘文件存在性的判断
If(fso.FileExists(csvFilePath) = false) then
 ‘打开文件
  Set csvfile = fso.OpentextFile(csvFilePath, 2, True)
 lngLineCnt = 0
 ‘循环数据集,将数据写入CSV文件
 Do While rsData.EOF = false
  'Excel 最大行数超过
  If lngLineCnt > 65535 Then Exit Do
  csvLine = ""
  For i = 0 To rsData.Fields.Count-1
   csvLine = csvLine & rsData.Fields.Item(i).Value & ","
  Next
  csvLine = Left(csvLine, len(csvLine)-1)
  csvfile.WriteLine( """*""," & csvLine )
  lngLineCnt = lngLineCnt + 1
  rsData.MoveNext
 Loop
End if
‘Excel模板文件生成
dim f2
set f2 = fso.getfile(Server.MapPath("templates/template1.xls"))
if(fso.FileExists(Server.MapPath("excel_download") & "/" & strFileNm & ".xls") = false) then
 ‘文件从web服务器的templates目录拷贝到excel_download目录
 ‘文件名与CSV文件名相同。
 f2.copy(Server.MapPath("excel_download") & "/" & strFileNm & ".xls")
end if

rsData.Close()
Set rsData = Nothing
%>


<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" Content="text/html;">
<TITLE></TITLE>
</HEAD>
<body bgcolor="#aaffff" topmargin="2">
<P align=center>&nbsp;</P>
<P align=center>Excel File is downloading , please wait for a
while..........</P>
<P align=center>
<!—下载按钮点击事件,对应到Excel文件 à
<input style="width: 188px; heigth: 32px" type=button size=63 value=Download name=download  language="javascript"
οnclick="location.href='./excel_download/<%=strFileNm%>.xls'">&nbsp;&nbsp;
<input style="width:80px;HEIGHT:29px" type=button size=27 value=Return name=button2></P>
</body>
</HTML>

二、Excel模板中宏的实现
1丄 在Excel文件打开时,自动执行数据读取处理
Private Sub Workbook_Open()
        Call GetData
End Sub
2丄 数据读取函数MdlDownload. GetData
Option Explicit
Private Const DATA_SHEET = "HaPiNS"     'Sheet 名
Private Const SERVER_URL = "http://127.0.0.1/dpms/csv/" 'Web服务器csv目录地址

Public Sub GetData()
    Dim oldStatusBar    As Boolean
    Dim strCsvName      As String
    Dim thisFilename    As String   '文件名

    On Error GoTo ErrProc
    Application.Cursor = xlWait
    blnCsvOpen = False
   
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Application.StatusBar = "从服务器上读取数据中..."

    ‘CSV文件名取得
thisFilename = ThisWorkbook.Name
    strCsvName = Replace(thisFilename, ".xls", "")
    Application.ScreenUpdating = False

    ''CSV文件打开
    Workbooks.OpenText (SERVER_URL & strCsvName & ".csv")
    blnCsvOpen = True
    '将CSV文件内容拷贝到Excel文件的一个Sheet
    Application.DisplayAlerts = False
    Sheets(strCsvName).Select
    Sheets(strCsvName).Copy Before:=Workbooks(thisFilename).Sheets(1)
   
    ''CSV文件关闭
    Windows(strCsvName & ".csv").Close
    blnCsvOpen = False
   
    '解析数据内容
    Windows(thisFilename).Activate
    Sheets(strCsvName).Select
    ‘ 将数据导入,生成报表(省略)
    ………………………………………………………
    ……………………………………………………..
    ''CSV内容删除
    Sheets(strCsvName).Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    Application.StatusBar = "数据读取完了"
    Application.DisplayStatusBar = oldStatusBar
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
    Exit Sub
ErrProc:
    If blnCsvOpen = True Then
        Windows(strCsvName & ".csv").Close
    End If
    If Err.Number <> 0 Then
        MsgBox ("数据读取出错" & vbCrLf & _
            "错误号:" & Err.Number & vbCrLf & "错误内容:" & Err.Description)
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
End Sub

 

 

 

  • 0
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值