网页上数据导出到EXCEL

引用方式: 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 //

网页上数据导出到EXCEL相关推荐

js 实现网页表格数据导出到Excel表
最近在做一个项目,涉及到导出数据到Excel表格,由于是采用的前后端分离模式开发的,之前常用的方法已经失效,在网上找了一些资料和方法 js文件下载地址 1.是采用的一个插件 xlsx.full.min ...
python 批量查询网页导出结果_python导出网页数据到excel表格-如何使用python将大量数据导出到Excel中的小技巧...
如何用python把返回的html提取相应的内容到excel 下载扩展库 xlrd 读excle xlwt 写excle 直百度上搜就能下载下载后使用 import xlrd 就读excle了打开 ...
H5将网页数据导出为Excel并可下载
H5将网页数据导出为Excel并可下载在制作webapp中,遇到个要将数据导出为Excel的问题.我搜索了一下网上的方案,可以直接将HTML的表格导出为Excel文件,这些方法在电脑上确实是可行的, ...
将数据库数据导出到Excel中，并可以在浏览器上下载Excel
将数据库数据导出到Excel中,并可以在浏览器上下载Excel 附代码: //设置文件保存路径 public static String url ="F:\\Workspase\\BackC ...
php 输入表格数据,怎样将导出数据输入Excel 表格-php 怎么把数据导出到excel表格...
如何将word文档中的数据导入到excel表格中方法如下: 1.首先,打开媒介工具"记事本",将word文件里需要导入的数据,复制粘贴到记事本当中,然后保存成为txt文件,本例中 ...
关于数据导出成excel表
关于数据导出成excel表咱们这里分享简单导出成excel表和筛选导出excel表,希望对各位有帮助,欢迎大家交流和点赞!!!! 我在这里使用的是一个导出工具类,如下: package cn.ms. ...
表格导出计算机,电脑怎么导出excel表格数据-如何将百度指数数据导出到Excel表格...
系统没有导出功能,电脑表格里的数据有什么方法拿... 将网页表格数据导入到Excel中的方法: 第一步,将包括所需表格的网页打开,并按CTRL C把网址复制到剪贴板,以备下一步使用. 第二步,打开运行 ...
jQuery表格数据导出成Excel插件
下载地址一款能将网页上的Table表格数据导出成Excel文件的插件,这个导出插件使用jQuery代码实现的,很实用的导出Excel插件. dd:
python读html导出excel,python数据导出到excel
如何使用python将大量数据导出到Excel中的安装openpyxl模块调用openpyxl模块,将变量中的数据写入excel 具体的操作流程需要根据您的需CSS布局HTML小编今天和大家分享和 ...

网页上数据导出到EXCEL

网页上数据导出到EXCEL相关推荐

最新文章

热门文章