网页上数据导出到EXCEL

原创 2004年03月16日 18:16:00

引用方式: Export(Ado.Recordset) 或 Export(Rds.RecordSet)

/////////////////// S T A R T //////////////////////////

Function FieldType(intType)
   Select Case intType
      Case 20
         FieldType = "int"
      Case 128
         FieldType = "binary"
      Case 11
         FieldType = "bit"
      Case 129
         FieldType = "char"
      Case 135
         FieldType = "datetime"
      Case 131
         FieldType = "varchar"
      Case 5
         FieldType = "float"
      Case 205
         FieldType = "image"
      Case 3
         FieldType = "int"
      Case 6
         FieldType = "money"
      Case 130
         FieldType = "char"
      Case 203
         FieldType = "text"
      Case 131
         FieldType = "numeric"
      Case 202
         FieldType = "varchar"
      Case 4
         FieldType = "real"
      Case 135
         FieldType = "datetime"
      Case 2
         FieldType = "int"
      Case 6
         FieldType = "money"
      Case 204
         FieldType = "varchar"
      Case 201
         FieldType = "text"
      Case 128
         FieldType = "timestamp"
      Case 17
         FieldType = "varchar"
      Case 72
         FieldType = "varchar"
      Case 204
         FieldType = "varbinary"
      Case 200
         FieldType = "varchar"
    End Select
End Function

Sub Export(AdoRecordSet)
Rem AdoRecordSet 传入一个对象,可以是 Rds.Recordset 或者是 Adodb.RecordSet
Rem 导出到用户桌面的  Query_数字组合.xls
On Error Resume Next
    Dim Excel_Dsn
    Dim Excel_Conn
    Dim Excel_Adodc
    Dim mySql, fs
    Dim i, j, TmpField, FileName, WshShell
    Rem 桌面路径
    Set WshShell = CreateObject("Wscript.Shell")
    Rem 创建一个连接
    Set Excel_Conn = CreateObject("ADODB.Connection")
    Rem 创建一条记录
    Set Excel_Adodc = CreateObject("ADODB.RecordSet")
    Rem 创建文件对象
    Set fs = CreateObject("Scripting.FileSystemObject")
    Rem 判断文件是否存在, 自动更名 (0 - 99), 可以修改
    For i = 0 To 99
        If Len(i) = 1 Then
            FileName = WshShell.SpecialFolders("Desktop") & "/Query_0" & i
        Else
            FileName = WshShell.SpecialFolders("Desktop") & "/Query_" & i
        End If
        If Not fs.FileExists(FileName & ".xls") Then
            Exit For
        End If
    Next
    FileName = FileName & ".xls"
    Rem 创建Excel驱动,一般 Window 98 以上的电脑都有这个驱动
    Excel_Dsn = "DRIVER={Microsoft Excel Driver (*.xls)};DSN='';FIRSTROWHASNAMES=1;READONLY=FALSE;CREATE_DB=""" & FileName & """;DBQ=" & FileName
    Excel_Conn.Open Excel_Dsn
    With AdoRecordSet
        If Not (.EOF And .BOF) Then
   .MoveFirst
            mySql = "Create Table [Query] ("
            For i = 0 To .Fields.Count - 1
                TmpField = FieldType(.Fields(i).Type)
                If TmpField = "char" Or TmpField = "varchar" Or TmpField = "nchar" Or TmpField = "nvarchar" Or TmpField = "varbinary" Then
                    If .Fields(i).DefinedSize >= 256 Then
                        mySql = mySql & Trim(.Fields(i).Name) & " text,"
                    Else
                        mySql = mySql & Trim(.Fields(i).Name) & " " & FieldType(.Fields(i).Type) & "(" & .Fields(i).DefinedSize & ")" & ","
                    End If
                Rem Image 的数据类型不导出
                ElseIf TmpField <> "image" Then
                    mySql = mySql & Trim(.Fields(i).Name) & " " & FieldType(.Fields(i).Type) & ","
                End If
            Next
            mySql = Left(Trim(mySql), Len(Trim(mySql)) - 1)
            mySql = mySql & ")"
            Rem 创建表名
            Rem 这个不能使用 Excel_Adodc.Close,因为等待这句执行完,对象会自动关闭,不会给服务器造成负担
            Excel_Adodc.Open mySql, Excel_Dsn
            Rem 捕捉错误信息
            If Err.number <> 0 Then
  MsgBox "发生错误:" & Err.Description, 64, "系统信息:"
  Exit Sub
            End If
            Rem 插入数据
            For i = 0 To .RecordCount - 1
                mySql = "Insert into [Query] Values("
                For j = 0 To .Fields.Count - 1
                    TmpField = FieldType(.Fields(j).Type)
                    Rem Image 的数据类型不导出
                    If TmpField <> "image" Then
   if ISNULL(.Fields(j).Value) then
                         mySql = mySql & "NULL,"
   else
                         mySql = mySql & "'" & Trim(.Fields(j).Value) & "',"
   end if
                    End If
                Next
                mySql = Left(Trim(mySql), Len(Trim(mySql)) - 1)
                mySql = mySql & ")"
                Rem 这个不能使用 Excel_Adodc.Close,因为等待这句执行完,对象会自动关闭,不会给服务器造成负担
                Excel_Adodc.Open mySql, Excel_Dsn
                Rem 捕捉错误信息
                If Err.number <> 0 Then
   MsgBox "发生错误:" & Err.Description, 64, "系统信息:"
   Exit Sub
                End If
                .MoveNext
            Next
            MsgBox "系统提示:" & Chr(13) & "已经将文件保存到 """ & FileName & """ ]", 64, "系统信息:"
        End If
        Rem 关闭与释放对象
        Excel_Conn.Close
        Set Excel_Conn = Nothing
        Set Excel_Adodc = Nothing
    End With
End Sub

////////////////////////////////// E N D   I F //////////////////////////////////

Servlet编程中,将网页数据导出到Excel

在实际的开发中,经常需要将一些数据da
  • u011084812
  • u011084812
  • 2014年08月26日 11:47
  • 1186

jsp页面表格数据导出到excel

在程序猿的日常工作中经常会遇到这样的问题,如何将jsp页面表格中的数据导出到excel中? 我所知道的第一种方法是 function method1(tableid) {//整个表格拷贝...
  • henu2009220176
  • henu2009220176
  • 2013年08月25日 10:39
  • 6287

如何将jsp页面的table报表转换到excel报表导出

(本文) 假设这就是你的jsp页面: 我们会添加一个“导出到excel”的超链接,它会把页面内容导出到excel文件中。那么这个页面会变成这个样子: 本篇教程我们会看到如何把JSP页...
  • a_as31243qadfg
  • a_as31243qadfg
  • 2016年08月19日 16:16
  • 2137

Asp.net网页中DataGridView数据导出到Excel

一、从DataGridView中直接导出数据到Excel文件    经过上网找资料,终于找到一种可以直接将GridView中数据导出到Excel文件的方法,归纳方法如下:  1、 注:其中的字符集...
  • ningmeng2010
  • ningmeng2010
  • 2013年03月20日 16:14
  • 3188

网页端中将表格数据和JSON数据读取(导出)到本地的excel和csv文件中

最近实验室接了一个web端的项目,自己负责的模块需要完成导出文件的工作。一开始,要求的是导出表格中的内容,这个...
  • u011133109
  • u011133109
  • 2016年06月23日 16:58
  • 566

Selenium学习三——利用Python爬取网页表格数据并存到excel

利用Python爬取网页表格数据并存到excel 1、具体要求: 读取教务系统上自己的成绩单,并保存到本地的excel中 2、技术要求: 利用Selenium+Python获取网页,自动登陆并...
  • yxStory
  • yxStory
  • 2017年09月25日 15:10
  • 1675

[Full script] 从网页获取数据写入Excel (API 模式)初稿

配置: 1. 关于 Excel 读写的时候可能会遇到的问题(基于Python 2.7)——      import xlwt ImportError: No module named xlwt Pyt...
  • No_Enemy
  • No_Enemy
  • 2015年12月16日 16:22
  • 716

如何把数据从网页中直接导入到excel中

把数据从网页中直接导入到excel中,下面就上代码。 页面js中导出的方法: function exportExcel() { var queryPara = sy.serializeObje...
  • kai_wei
  • kai_wei
  • 2016年03月19日 19:55
  • 503

Selenium学习四——利用Python爬取网页多个页面的表格数据并存到已有的excel中

利用Python爬取网页多个页面的表格数据并存到已有的excel中 1、具体要求 获取牛客网->题库->在线编程->剑指Offer网页,获取表格中的全部题目,保存到本地excel中 ...
  • yxStory
  • yxStory
  • 2017年09月26日 12:04
  • 276

《程序员的第一年》---------- 【抓取网页数据】定时查寻淘宝搜索结果并用excel记录下来(HttpWebRequest与正则等的使用)

《程序员的第一年》---------- 【抓取网页数据】定时查寻淘宝搜索结果并用excel记录下来(HttpWebRequest与正则等的使用) 最近在看一些关于HttpWebRequest与正则来...
  • QQ247085994
  • QQ247085994
  • 2013年07月29日 17:16
  • 2111
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:网页上数据导出到EXCEL
举报原因:
原因补充:

(最多只允许输入30个字)