3月9

Access数据表汇入excel

大 | 中 | 小
13:36tommyhu ASP  From: 本站原创
如何将Access数据表汇入excel
1.将access数据文件汇入excel
启动Excel，〔数据〕〔汇入外部数据〕〔汇入数据〕在〔选取数据源窗口〕
Highslide JS
中选取目的.mdb档案后按开启，跳出〔选取表格视窗〕
Highslide JS
选取表格后按确定，跳出〔汇入资料视窗〕
Highslide JS
确定汇入后，sheet1更名为资料表名
[img][attach]59[/attach][/img]
Highslide JS
底下是我将song.mdb的〔list〕资料表单，汇入test.xls的〔list〕table，然后再用微软提供的excel odbc
"Driver={Microsoft Excel Driver (*.xls)};"&"DBQ=" & Server.MapPath("test.xls")
开启后输出资料到网页........
程序代码
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="UTF-8">
<head>
    <meta http-equiv="Content-Type" content="text/html; charset=big5" />
    <meta http-equiv="Content-Language" content="big5" />
</head>
<BODY bgcolor=ffffff marginheight=0 marginwidth=0 leftmargin=0 topmargin=0>
<center>
<table border=2 width=984>
<tr valign=top><td width=5%>编号</td><td width=10%>歌手名</td><td width=5%>歌数</td><td width=20%>代表歌</td><td width=60%>歌手简介</td></tr>
<%
Set conn = Server.CreateObject("ADODB.Connection")  
conn.open "Driver={Microsoft Excel Driver (*.xls)};"&amp;amp;"DBQ=" &amp;amp; Server.MapPath("test.xls")  
sSQL = "Select * FROM [list$]"
set Rs = Server.CreateObject("Adodb.Recordset")  
Rs.Open sSQL,conn
do until rs.eof
   response.write "<tr valign=top><td>"&amp;amp;rs("RecordID")&amp;amp;"</td>"
   response.write "<td align=left>"&amp;amp;rs("Reareana")&amp;amp;"</td>"
   response.write "<td>"&amp;amp;rs("Songno")&amp;amp;"</td>"
   response.write "<td align=left>"&amp;amp;rs("Bestone")&amp;amp;"</td>"  
   response.write "<td align=left>"&amp;amp;rs("Content")&amp;amp;"</td></tr>"
   rs.movenext
loop  
Rs.close
%>  
</table></center>
</body>
2.
使用server对象Excel.Application来存取(建立)excel档案

使用这个对象前，必需先作好设定，不然Set xlApp=server.CreateObject("Excel.Application") ，会发生
__服务器对象 错误 'ASP 0178 : 80070005' Server.CreateObject 存取错误 /test3.asp, 列40 当检查权限时 Server.CreateObject 的呼叫失败。拒绝存取此对象。

控制面板->系统管理工具->组件服务->计算机->我的计算机->DCOM设定->Microsoft Excel 应用程序->内容->安全设定" 将因特网使用者账号新增这个方法
访问权限，新增Everyone，远程访问打勾...

Highslide JS
'建立Excel对象
set objExcelApp=CreateObject("Excel.Application")
'不显示警告
objExcelApp.DisplayAlerts=false
'不显示界面                                                              
objExcelApp.Application.Visible=false

'新建Excel文件
objExcelApp.WorkBooks.add
set objExcelBook=objExcelApp.ActiveWorkBook
set objExcelSheets=objExcelBook.Worksheets
set objExcelSheet=objExcelBook.Sheets(1)

'读取已有Excel文件
strAddr=Server.MapPath("xls/Table.xls")
objExcelApp.WorkBooks.Open strAddr
set objExcelBook=objExcelApp.ActiveWorkBook
set objExcelSheets=objExcelBook.Worksheets
set objExcelSheet=objExcelBook.Sheets(1)

'更改Sheets1为会员数据表
objExcelSheet.name="会员数据表"
      
'另存Excel文件
objExcelBook.SaveAs  strAddr&"\Temp\Table.xls"

'保存Excel文件
objExcelBook.Save

'退出Excel操作(一定要退出否则档案会一直处于只读)
objExcelApp.Quit                              
set objExcelApp=Nothing

'指定域值
objExcelSheet.Cells(i,j).value="指定这个字段的值"

注:
ASP最好在CreateObject("Excel.Application")前加上
On Error Resume Next
最后加上
objExcelApp.Quit
set objExcelApp=Nothing
(避免因为错误讯息中断程序执行，而使Excel档一直处于只读状态)

底下这个示范是：建立一个EXCEL新档，并依选取条件将Access档符合条件的资录汇入EXCEL
1.EXCEL数据表名=选取的歌手名
2.EXCEL檔名=歌手名2008MMDDHHMMSS.XLS
3.Access数据表中的字段属性若为时间，需先强制型态转换成文字，A=Cstr(A)，再写入..

实际RUN起来的结果：
建立一个EXCEL档，只有一张数据表单，50~80笔记录，档案大小20~30K，费时1~2秒..
(WebServer：IIS　处理器：Intel Core 2 Quad Q9550　内存：4G　操作系统XP Sp3)
程序代码
<HEAD><TITLE>建立一个EXCEL档并依选取条件将Access档符合条件的资录录汇入EXCEL</TITLE>
<META content="text/html; charset=big5" http-equiv=Content-Type>
<link REL="stylesheet" HREF="../../../style.css" TYPE="text/css">
</HEAD>
<body   bgcolor=ffffff marginheight=0 marginwidth=0 leftmargin=0 topmargin=0>
<%
area=request("area")
areana=request("areana")
If request("Request_Method")="POST" Then
   reareana=request("reareana")
  
   Set objExcelApp=server.CreateObject("Excel.Application")    
   objExcelApp.DisplayAlerts=false  
   objExcelApp.Application.Visible=false
    
   objExcelApp.WorkBooks.add
   set objExcelBook=objExcelApp.ActiveWorkBook
   set objExcelSheets=objExcelBook.Worksheets
   set objExcelSheet=objExcelBook.Sheets(1)
   objExcelSheet.name=reareana
   objExcelSheet.Cells(1,1).value="id"
   objExcelSheet.Cells(1,2).value="area"
   objExcelSheet.Cells(1,3).value="areana"
   objExcelSheet.Cells(1,4).value="reareana"  
   objExcelSheet.Cells(1,5).value="filename"
   objExcelSheet.Cells(1,6).value="url"
   objExcelSheet.Cells(1,7).value="gd"
   objExcelSheet.Cells(1,8).value="hits"
   objExcelSheet.Cells(1,9).value="last_update"
   I=1  
   set conn=Server.CreateObject("ADODB.Connection")
   Provider="Provider=MicroSoft.Jet.OLEDB.4.0;"
   DBPath="Data Source=" &amp;amp; Server.MapPath("song.mdb")
   conn.open Provider &amp;amp; DBPath
   Set rs = Server.CreateObject("adodb.recordset")    
   sqlstr="Select * From song where areana='"&amp;amp;areana&amp;amp;"' And reareana='"&amp;amp;reareana&amp;amp;"' order by [ID] desc"
   rs.open sqlstr,conn,3,2  
   Do until rs.EOF
      i=i+1  
      objExcelSheet.Cells(i,1).value=rs("id")
      objExcelSheet.Cells(i,2).value=rs("area")
      objExcelSheet.Cells(i,3).value=rs("areana")
      objExcelSheet.Cells(i,4).value=rs("reareana")  
      objExcelSheet.Cells(i,5).value=rs("filename")
      objExcelSheet.Cells(i,6).value=rs("url")
      objExcelSheet.Cells(i,7).value=rs("gd")
      objExcelSheet.Cells(i,8).value=rs("hits")
      last_update=rs("last_update")
      A=Cstr(last_update)
      objExcelSheet.Cells(i,9).value=A
      rs.MoveNext
   Loop
   rs.close
   conn.close
   strpath="excel/"&amp;amp;reareana
   yr=Year(now)
   mth=Month(now)
   if mth<10 then mth="0"&amp;amp;mth
   dy=day(now)
   if dy<10 then dy="0"&amp;amp;dy
   hr=hour(now)
   if hr<10 then hr="0"&amp;amp;hr
   mte=minute(now)
   if mte<10 then mte="0"&amp;amp;mte
   sec=second(now)
   if sec<10 then sec="0"&amp;amp;sec
   strpath=strpath&amp;amp;yr&amp;amp;mth&amp;amp;dy&amp;amp;hr&amp;amp;mte&amp;amp;sec&amp;amp;".xls"
   strAddr=Server.MapPath(strpath)
   objExcelBook.SaveAs strAddr
   objExcelApp.Quit
   set objExcelApp=Nothing
   Response.Write "Excel存盘实体路径文件名："&amp;amp;strAddr&amp;amp;"<BR><BR>"
   Response.Write "Excel虚拟相对路径文件名：<A HREF="&amp;amp;strpath&amp;amp;">"&amp;amp;strpath&amp;amp;"</A><BR><BR>"
   Response.Write "Excel档的数据表单名称："&amp;amp;reareana&amp;amp;"<BR><BR>"  
   Response.Write "<A HREF=/><FONT SIZE=5><B>回首页</B></FONT></A><BR>"
   Response.End
End If  
%>
<CENTER>
<form action=create_excel.asp method=post>
<table border="1" align="center" width=400>
<tr><td width=75>音乐分类</td><td width=325>
<select name=WebUrl size=1 onChange='location.href=this.options[this.selectedIndex].value;' style='font-size: 12pt; border: 1 solid #000000'>
<option value='' Selected>选择音乐分类</option>
<%
Set conn=Server.CreateObject("ADODB.Connection")
param = "driver={Microsoft Access Driver (*.mdb)}"
conn.Open param &amp;amp; ";dbq=" &amp;amp; Server.MapPath("song.mdb")
Set rs1=Server.CreateObject("ADODB.Recordset")
SortSql="Select * From area order By [area]"
rs1.Open SortSql, conn, 1,3
Do until rs1.EOF
   If areana=rs1("areana") Then
      response.write "<option value=Create_excel.asp?areana="&amp;amp;rs1("areana")&amp;amp;" Selected>"&amp;amp;rs1("areana")&amp;amp;"</option>"
   Else
      response.write "<option value=Create_excel.asp?areana="&amp;amp;rs1("areana")&amp;amp;">"&amp;amp;rs1("areana")&amp;amp;"</option>"  
   End If    
   rs1.MoveNext
Loop
rs1.close  
Response.write "</select></td></tr>"
Select Case areana
  Case "乐器演奏"
    area=11  
  Case "古典歌谣"
    area=12
  Case "情调音乐"
    area=13
  Case "国语歌曲"
    area=21
  Case "台语歌曲"
    area=22  
  Case "西洋歌曲"
    area=23
  Case "日韩歌曲"
    area=24  
  Case "歌剧演唱"
    area=25  
  Case "国语唱将"
    area=27  
  Case "西洋唱将"
    area=28      
  Case "一般视频"
    area=31
  Case "高清视频"
    area=32  
End Select
response.write "<input type='hidden' name='area' value='"&amp;amp;area&amp;amp;"'>"
response.write "<input type='hidden' name='areana' value='"&amp;amp;areana&amp;amp;"'>"
response.write "<td>音乐目录</td><td><select name='reareana' size='1'>"
set conn=Server.CreateObject("ADODB.Connection")
Provider="Provider=MicroSoft.Jet.OLEDB.4.0;"
DBPath="Data Source=" &amp;amp; Server.MapPath("song.mdb")
conn.open Provider &amp;amp; DBPath
Set rs=Server.CreateObject("ADODB.Recordset")
IF areana<>"" Then
   SortSql="Select * From List where areana='" &amp;amp;areana&amp;amp; "' order By [Recordid]"
Else
   SortSql="Select * From List order By [Recordid]"
End If
rs.Open SortSql, conn, 1,3
Do until rs.EOF
   response.write "<option value="&amp;amp;rs("reareana")&amp;amp;" selected>"&amp;amp;rs("reareana")&amp;amp;"</option>"
   rs.MoveNext
Loop
rs.close
%>
</select></td></tr>
<tr align="center"><td colspan="2"><input type="submit" name="addphoto" value="建立 (<%=areana%>.xls) 檔 - 数据表_歌手名"><input type="reset"  value="取消"></td></tr>
</table>



使用server.CreateObject("Excel.Application") 读取已有Excel文件，并写入Access

实例示范


程序代码
<HEAD><TITLE>建立一个EXCEL档并依选取条件将Access档符合条件的资录录汇入EXCEL</TITLE>
<META content="text/html; charset=big5" http-equiv=Content-Type>
<link REL="stylesheet" HREF="../../../style1.css" TYPE="text/css">
</HEAD>
<body   bgcolor=ffffff marginheight=0 marginwidth=0 leftmargin=0 topmargin=0>
<%
If request("Request_Method")="POST" Then
   areana=request("areana")
   strAddr=Server.MapPath("excel/"&amp;amp;areana)
   'On Error Resume Next
   '建立Excel对象
   set objExcelApp=CreateObject("Excel.Application")
   '不显示警告
   objExcelApp.DisplayAlerts=false
   '不显示界面                                                              
   objExcelApp.Application.Visible=false
   '读取已有Excel文件
   objExcelApp.WorkBooks.Open strAddr
   set objExcelBook=objExcelApp.ActiveWorkBook
   set objExcelSheets=objExcelBook.Worksheets
   set objExcelSheet=objExcelBook.Sheets(1)
   i=2
   set conn=Server.CreateObject("ADODB.Connection")
   Provider="Provider=MicroSoft.Jet.OLEDB.4.0;"
   DBPath="Data Source=" &amp;amp; Server.MapPath("db/song.mdb")
   conn.open Provider &amp;amp; DBPath
   Set rs = Server.CreateObject("adodb.recordset")    
   sqlstr="Select Top 1 * From song order By id Desc"
   rs.open sqlstr,conn,3,2
   Do until i>500
     rs.AddNew
     'rs("id")=objExcelSheet.Cells(i,1).value
     rs("area")=objExcelSheet.Cells(i,2).value
     rs("areana")=objExcelSheet.Cells(i,3).value
     rs("reareana")=objExcelSheet.Cells(i,4).value
     rs("filename")=objExcelSheet.Cells(i,5).value
     rs("url")=objExcelSheet.Cells(i,6).value
     rs("gd")=objExcelSheet.Cells(i,7).value
     rs("hits")=objExcelSheet.Cells(i,8).value
     'last_update=objExcelSheet.Cells(i,9).value
     'A=Cdate(last_update)
     'rs("last_update")=A
     rs.Update
     i=i+1
     If objExcelSheet.Cells(i,1).value="" Then Exit do
   loop
   rs.close

   '退出Excel操作(一定要退出否则档案会一直处于只读)
   objExcelApp.Quit                              
   set objExcelApp=Nothing

   k=i-2
   s=0
   Response.write "<Div align=left><font size=5><b>表列刚刚由Excel写入Access的数据</b></font></Div>"
   Response.write "<table border=1><tr><td>编号</td><td>分类编号</td><td>分类名称</td><td>歌手</td><td>歌曲</td><td>相对地址</td><td>精选</td><td>浏览次数</td><td>最后更新</td></tr>"
   '输出刚刚写入的记录
   set conn=Server.CreateObject("ADODB.Connection")
   Provider="Provider=MicroSoft.Jet.OLEDB.4.0;"
   DBPath="Data Source=" &amp;amp; Server.MapPath("db/song.mdb")
   conn.open Provider &amp;amp; DBPath
   Set rs = Server.CreateObject("adodb.recordset")    
   sqlstr="Select * From song order By id Desc"
   rs.open sqlstr,conn,3,2
   do until s=k
      s=s+1
      response.write "<tr valign=top align=center><td>"&amp;amp;rs("id")&amp;amp;"</td>"
      response.write "<td align=center>"&amp;amp;rs("area")&amp;amp;"</td>"
      response.write "<td align=left>"&amp;amp;rs("areana")&amp;amp;"</td>"
      response.write "<td align=left>"&amp;amp;rs("Reareana")&amp;amp;"</td>"
      response.write "<td align=left>"&amp;amp;rs("filename")&amp;amp;"</td>"
      response.write "<td align=left>"&amp;amp;rs("url")&amp;amp;"</td>"
      GD=rs("gd")
      If GD=1 Then
         response.write "<td align=center>是</td>"
      Else
         response.write "<td align=center>否</td>"
      End If    
      response.write "<td align=center>"&amp;amp;rs("hits")&amp;amp;"</td>"  
      response.write "<td align=left>"&amp;amp;rs("last_update")&amp;amp;"</td></tr>"
      rs.movenext
   loop
   Rs.close
   conn.close
   Response.write "</table>"  
   response.end
End If
%>
<CENTER>
<form action=ExcelToAccess.asp method=post>
<table border="1" align="center" width=400>
<tr><td>选一个EXCEL档案</td>
<td>
<select name="areana" size="1">
<option value="孟庭苇.xls" selected>孟庭苇.xls</option>
<option value="秀兰玛雅.xls">秀兰玛雅.xls</option>
<option value="林忆莲.xls">林忆莲.xls</option>
<option value="张宇.xls">张宇.xls</option>
<option value="郑秀文.xls">郑秀文.xls</option>
<option value="黄莺莺.xls">黄莺莺.xls</option>
</select></td></tr>
<tr align="center"><td colspan="2"><input type="submit" name="ExcelToAccess" value="送出"><input type="reset"  value="取消"></td></tr>
</table>
最后编辑： tommyhu 编辑于2009/03/09 13:39
Tags:
阅读(4158) | 评论(1) | 引用(0)
tommyhuc.cn网友
2012/02/13 11:37
我想我明白楼主的意思了
分页： 1/1 第一页 1 最后页
在此留下酱油瓶-：）
表情
emotemotemotemotemotemotemotemotemotemotemotemotemotemotemotemot
打开HTML
打开UBB
打开表情
隐藏
记住我

您的大名（例如：小明） ： 

密码(可不填) ：  游客无需密码

网址 (可不填) ： 

电邮 (可不填) ：  [注册]