下面的代码是asp实现数据库导出excel文件我总是实现不了，下面的那个是数据表名要改那些，我的数据库是erdt.mdb要导出的表名student里面的数据为excel文件。
我把singup改成student运行后一直在读就是出不来，看任务管理器dllhost.exe文件占100% 请高手指点。


<!--#include file=conn.asp-->
<%
'**********************************************
'　　　 Code by ASP导出EXCEL通用 
' 修改引用 By 子言(JaStudio) 
' QQ:23638564 Email:kpggdf@163.com
' web:www.gdsspt.com　　 
'**********************************************
Dim xibua
Dim mysql
xibua = Request.QueryString("ids")
if xibua="all" Then
mysql = "select * from singuo"
Else
mysql = "select * from singup where [系部]='"&dh&"'"
End If
server.scripttimeout=100000  '处理时间较长，设置值应大一点
On Error Resume Next 
set objExcelApp = CreateObject("Excel.Application")
objExcelApp.DisplayAlerts = false
objExcelApp.Application.Visible = false
objExcelApp.WorkBooks.add
set objExcelBook = objExcelApp.ActiveWorkBook
set objExcelSheets = objExcelBook.Worksheets
set objSpreadsheet = objExcelBook.Sheets(1)
Dim objRS
Set objRS = Server.CreateObject("ADODB.Recordset") 
objRS.Open mysql,conn,1,3 
If objRS.EOF then 
response.write("Error") 
respose.end
End if

Dim objField, iCol, iRow 
iCol = 1 '取得列号
iRow = 1 '取得行号
objSpreadsheet.Cells(iRow, iCol).value = ""&xibua&"部的报名情况" '单元格插入数据
objSpreadsheet.Columns(iCol).ShrinkToFit=true '设定是否自动适应表格单元大小(单元格宽不变）
'设置Excel表里的字体 
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True '单元格字体加粗
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False '单元格字体倾斜
objSpreadsheet.Cells(iRow, iCol).Font.Size = 20 '设置单元格字号
objSpreadsheet.Cells(iRow, iCol).ParagraphFormat.Alignment=1 '设置单元格对齐格式:居中
objspreadsheet.Cells(iRow,iCol).font.name="宋体" '设置单元格字体
objspreadsheet.Cells(iRow,iCol).font.ColorIndex=2 '设置单元格文字的颜色，颜色可以查询，2为白色
objSpreadsheet.Range("A1:F1").merge '合并单元格(单元区域)
objSpreadsheet.Range("A1:F1").Interior.ColorIndex = 1 '设计单元络背景色
'objSpreadsheet.Range("A2:F2").WrapText=true '设置字符回卷（自动换行）
iRow=iRow+1
For Each objField in objRS.Fields 
'objSpreadsheet.Columns(iCol).ShrinkToFit=true
objSpreadsheet.Cells(iRow, iCol).value = objField.Name
'设置Excel表里的字体 
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True 
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False 
objSpreadsheet.Cells(iRow, iCol).Font.Size = 20 
objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中 
iCol = iCol + 1 
Next 'objField 
'Display all of the data 
Do While Not objRS.EOF 
iRow = iRow + 1 
iCol = 1 
For Each objField in objRS.Fields 
If IsNull(objField.value) then 
objSpreadsheet.Cells(iRow, iCol).value = "" 
Else 
objSpreadsheet.Columns(iCol).ShrinkToFit=true 
objSpreadsheet.Cells(iRow, iCol).value = objField.value 
objSpreadsheet.Cells(iRow, iCol).Halignment = 2
objSpreadsheet.Cells(iRow, iCol).Font.Bold = False 
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False 
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10 
'objSpreadsheet.Cells(iRow, iCol).Halignment = 2
objSpreadsheet.Cells(iRow, iCol).ParagraphFormat.Alignment=1
End If 
iCol = iCol + 1 
Next 'objField 
objRS.MoveNext 
Loop 

Dim SaveName 
SaveName=xibua
Dim objExcel 
Dim ExcelPath 
ExcelPath = "Excel/" & SaveName & ".xls"
objExcelBook.SaveAs server.mappath(ExcelPath)
Response.Write "<center><b>导出成功,请选择继续操作</b></center>"
response.Write "<table width=90% bgcolor=gray bgcolor=CCCCCC cellspacing=1 cellpadding=3 align=center>"
Response.Write "<tr align=center bgcolor=#6699CC style=color:white> <td>"
response.write("<font color=green>√</font><a href='" & ExcelPath & "'>下载 </a>") & "　<font color=green>√</font><A href=javascript:history.back()>返回上一页</a>"
Response.Write "</td></tr></table>"
objExcelApp.Quit
set objExcelApp = Nothing
%>