Access911.net   |   a9BBS   |   OTaA System  
  搜索文章:  
Access911欢迎您光临  
   主页      上传      繁體版       论坛     
设为首页  |  加入收藏   
  
你现在的位置:文章索引 -> 文章分类 -> VBA  
 首页|  近日更新|  下载  |  文章索引  |  搜索|  术语|  承接工程|  
 
系统正在加载内容,请耐心等待...
 
 查询
 窗体
 报表
 
 
 VBA
 函数
 ADO/DAO/ADO.NET
 API
 ADP
 安全
 发布
 OA
 ASP/ASP.NET
 其他语言
 控件
 DELPHI
 C#/.Net
 本站
 其他
 小例程
 常用软件
 参考文档
 业主作品
 网友大作
 
 
友情链接
 access911.net
 
访问人次
 1701859
 
站长 E-Mail
 net911@sina.com
 access911@gmail.com
 
RSS 订阅

显示附加信息 >>>

如何不调用EXCEL.APPLICATION将RECORDSET数据导出为EXCEL表格?

作者:cg1  摘自:access911.net  :cg1  更新日期:2010-9-6  浏览人次:

 

问题:

如何不调用EXCEL.APPLICATION将RECORDSET数据导出为EXCEL表格?
一般要导出到 XLS 文件都是用 OLE 方式,也就是创建 EXCEL.APPLICATION 的方法来导出,但是微软并不推荐这种方法,那么除了用 EXCEL.APPLICATION 方法还有其他什么方法?

 


回答:

方法很多,比如用 ODBC 直接操作 XLS 这种文件格式。还有用 XLS 能够另存为 XML 数据表的特性直接组织 XML 字符串的方式。本文就介绍组织 XML 表格的方式。这种方式比较灵活,在 ASP 环境下也能使用。而且还能根据需要修改各种显示格式。

而操作 XML 也有多种方式,比如直接用拼接字符串形成 XML 文档的方法;或者用 XML DOM 来形成文档。两种方法各有优劣,本文介绍用拼接字符串的方法。

界面截图:图片如下:
按此在新窗口浏览图片

建立一个名为 clsRecordsetToXls 的类模块

Option Compare Database

'===========================================================
' 类名        :  clsRecordsetToXls
' 版本号      :  2.0
' 说明        :  本模块用于导出内存中的Recordset数据到某个xml
'                 文档。导出的进度可以用订阅事件来探察。减少了
'                 与界面的耦合。相对1.0增加了事件订阅。
' 引用        :  Microsoft ActiveX Data Objects 2.1 Library
'                 Microsoft Scripting Runtime
' 调用演示    :  请参考调用示例
' 最后修改日期:  2010-9-6 23:36:00
' 示例地址    :  http://access911.net/?kbid;72FABF1E17DCEDF3
' 作者        :  cg1
' 网站        :  http://access911.net
' 电子邮件    :  access911@gmail.com
' 版权        :  作者保留一切权力,
'                 请在公布本代码时将本段说明一起公布,谢谢!
'===========================================================

Public Enum ParametersReturnField
    eepChs = 1          '中文字段名
    eepEng = 2          '英文字段名
    eepVisible = 3      '该字段是否可见
    eepVbConst = 4      'ADODB 的数据类型常量数值,10进制
    eepExcelConst = 5   'Excel 的XML数据类型常量,字符串
    eepReportName = 6   '报表的名称。一个参数表可以存放多种报表,以报表名称区分。
End Enum
Private Const PARAMETERS_TABLE_FIELD As String = ",ColChs,ColEng,Visible,DataTypeConst,ExcelDataTypeString,ReportName"
Private Const STRING_PAGESZIE As Long = 60000   '组织字符串后每多少个字符后写入到硬盘的文件中。
Private rsFld As New ADODB.Recordset
Private rsData As New ADODB.Recordset
Private conn As New ADODB.Connection


Public blnStop As Boolean
Public t As Double

Private strReportName As String
Private strXlsFullPath As String
Private strXlsEncoding As String
Private strXlsHead As String
Private strXlsHeadDefault As String
Private strXlsFoot As String
Private blnParametersRecordset As Boolean   'true表示参数为内存赋值,false表示参数直接从参数表中获取。
Private dblStartTimer As Double   '开始处理时间。秒数
Private dblEndTimer As Double


'当开始导出数据时,出发导出事件。
'参数:都是按地址传递
'currentRow 当前正在处理的行号
'recordCount 行数总和
'rs就是当前正在导出的记录集,
'fieldName当前正在导出的字段,
'cancel表示是否取消本次导出。
Public Event Exporting(ByVal currentRow As Long, _
    ByVal recordCount As Long, _
    ByVal currentTimer As Double, _
    ByRef rs As ADODB.Recordset, _
    ByRef field As ADODB.field, _
    ByRef cancel As Boolean)
'用户手动停止触发的事件
Public Event ProcessStop(ByVal currentRow As Long, _
    ByVal recordCount As Long, _
    ByVal currentTimer As Double, _
    ByRef msg As String)
'记录处理结束
'currentRow 当前导出的行
'successed 为true则表示成功,false表示有失败项目
'msg 失败或者成功的提示
Public Event ProcessEnd(ByVal currentRow As Long, _
    ByVal currentTimer As Double, _
    ByVal successed As Boolean, _
    ByVal msg As String)


'需要到处成xls的具体数据就存放在这个属性中
Public Property Set DataRs(ByRef rs As ADODB.Recordset)
    Set rsData = rs
End Property

'导出的xml格式xls存放在哪里
Public Property Let XlsFullPath(ByVal s As String)
    strXlsFullPath = s
End Property

'设定用于获取参数表中的数据的链接字串。
Public Property Set ActiveConnection(ByRef c As ADODB.Connection)
    Set conn = c
    blnParametersRecordset = False
End Property

'判断参数表示从内存中获取还是从数据库的表中获取。
Public Property Get IsParaFromRs() As Boolean
    IsParaFromRs = blnParametersRecordset
End Property

'将内存中创建的参数表传递到类中。
Public Property Set ParaRs(ByRef rs As ADODB.Recordset)
    Set rsFld = rs
    blnParametersRecordset = True
End Property


Public Property Let XlsEncoding(ByVal s As String)
    '默认编码为gb2312
    
    If s = "" Then
        strXlsEncoding = "GB2312"
    ElseIf LCase(s) = "gb2312" Then
        strXlsEncoding = "GB2312"
    ElseIf LCase(s) = "utf-8" Then
        strXlsEncoding = "UTF-8"
    Else
        Err.Raise vbObjectError + 515, "clsRecordsetToXls.XlsEncoding Property Let", "目前只支持 GB2312 和 UTF-8 两种编码。"
    End If
    
    strXlsHead = Replace(strXlsHeadDefault, "[encoding property]", "encoding=""" & strXlsEncoding & """")
    
End Property

'设定报表名称。主要用于查询参数表。报表名称只能是英文和数字。
Public Property Let ReportName(ByVal v As String)
    Dim i As Long
    Dim s As String
    
    For i = 1 To Len(v)
        s = Mid(v, i, 1)
        If (Asc(s) >= Asc("0") And Asc(s) <= Asc("9")) Or _
            (Asc(s) >= Asc("a") And Asc(s) <= Asc("z")) Or _
            (Asc(s) >= Asc("A") And Asc(s) <= Asc("Z")) Then
        Else
            Err.Raise vbObjectError + 514, "clsRecordsetToXls.ReportName Property Let", "ReprotName属性中包含非法字符:" & s & "。"
        End If
    Next
    strReportName = v
End Property

'判断处理过程是否停止,用按地址传递的方法传递一个变量进来
Public Property Let ProcesStop(ByVal v As Boolean)
    blnStop = v
End Property

'创建导出到EXCEL时要使用的参数表,只在数据库中不包含参数表时使用一次。用于预先配置数据库。
Function CreateExportParaTable()
    Dim strSql As String
    strSql = "create table ExportExcelParam1 (Id AUTOINCREMENT(1,1) PRIMARY KEY,ColChs varchar(200),ColEng varchar(200),Visible yesno,DataTypeConst long,ExcelDataTypeString varchar(200),ReportName varchar(200))"
    conn.Execute strSql
End Function


'在内存中创建参数recordset。用于当参数不放在表中时进行操作。
Public Function CreateParametersRs(ByVal fieldDescString As String, ByRef rs As ADODB.Recordset)
    Dim s1() As String
    Dim s2 As String
    
    Set rs = New ADODB.Recordset
    '下面用 adodb.recordset 进行排序
    rs.CursorLocation = adUseClient
    rs.Fields.Append "ColChs", adVarChar, 255
    rs.Fields.Append "ColEng", adVarChar, 255
    rs.Fields.Append "Visible", adBoolean, 255
    rs.Fields.Append "DataTypeConst", adInteger
    rs.Fields.Append "ExcelDataTypeString", adVarChar, 255
    rs.Fields.Append "ReportName", adVarChar, 255
    rs.Open
    
    '中文,英文,true,122,String,ReportName
    If fieldDescString <> "" Then
        s1 = Split(fieldDescString, ",")
        If UBound(s1) + 1 Mod 6 = 0 Then
            Debug.Print "dddddddddd"
        End If
        For i = 0 To UBound(s1)
            rs.AddNew
            rs("ColChs").Value = Trim(s1(i))
            rs("ColEng").Value = Trim(s1(i + 1))
            rs("Visible").Value = CBool(Trim(s1(i + 2)))
            rs("DataTypeConst").Value = CLng(Trim(s1(i + 3)))
            rs("ExcelDataTypeString").Value = Trim(s1(i + 4))
            rs("ReportName").Value = Trim(s1(i + 5))
            rs.Update
            i = i + 5
        Next
    End If
    
    
End Function

'根据到处功能的参数定义表
Private Function FieldProperty(ByVal filter As String, ByVal returnField As ParametersReturnField) As String
    If rsFld.State <> adStateOpen Then
        Set rsFld = New ADODB.Recordset
        If blnParametersRecordset = False Then
            rsFld.CursorLocation = adUseClient
            rsFld.Open "select * from ExportExcelParam where reportname ='" & strReportName & "'", conn, adOpenStatic, adLockReadOnly
        Else
            Err.Raise vbObjectError + 545, "clsRecordsetToXls.FieldProperty", "在检查字段参数定义时发现错误:未能从内存中读取到导出字段设置参数表,请确认已经正确设定ParaRs属性。"
        End If
    End If
    
    rsFld.filter = Split(PARAMETERS_TABLE_FIELD, ",")(ParametersReturnField.eepEng) & "='" & filter & "'"
    If rsFld.recordCount = 1 Then
        FieldProperty = rsFld(Split(PARAMETERS_TABLE_FIELD, ",")(returnField)).Value
    ElseIf rsFld.recordCount > 1 Then
        Err.Raise vbObjectError + 549, TypeName(Me) & ".FieldProperty", "在检查字段参数定义时发现错误:对字段《" & filter & "》的设定有重复,请开发人员进行检查导出参数表!"
    ElseIf rsFld.recordCount = 0 Then
        Debug.Print "未找到英文字段名为:" & filter & " 的设定,现在忽略。"
    End If
End Function

'替换XML中需要encode的字符。
Private Function CheckXmlString(ByVal s As Variant) As String
    If IsNull(s) = False Then
        '注意,以下代码在网页中会显示不正常。
        s = Replace(s, "&", "&")    '&amp
        s = Replace(s, ">", ">")     '&gt;
        s = Replace(s, "<", "<")     '&lt;
        s = Replace(s, """", """)  '&quot;
        s = Replace(s, "'", "'")   '&apos;
        CheckXmlString = s
    End If
End Function

'在指定字符串旁边添加tag标志。dataType为可选,如果赋值了,则添加excel xml 特有的ss:Type 和 ss:StyleId属性。
Private Function AddTag(ByVal v As String, ByVal tagName As String, Optional ByVal dataType As String, Optional ByVal styleId As String) As String
    Dim strType As String
    Dim strStyle As String
    
    If dataType = "" Then
        strType = ""
    Else
        strType = " ss:Type='" & dataType & "'"
    End If
    
    If styleId = "" Then
        strStyle = ""
    Else
        strStyle = " ss:StyleID='" & styleId & "'"
    End If
    
    AddTag = "<" & tagName & strType & strStyle & ">" & v & "</" & tagName & ">"
    
End Function


Private Function WriteHeadFoot(ByVal filename As String)
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    'Set a = fs.CreateTextFile(filename, True)
    Set a = fs.OpenTextFile(filename, 1, True)
    Dim s As String
    s = a.readall
    a.Close
    Set a = fs.CreateTextFile(filename, True)
    a.write ReadHead() & s & ReadFoot()
    a.Close

End Function

Public Function DoExport()
    
    RsToXls rsData, strXlsFullPath
End Function

'根据参数recordset 导出其导出参数模板字符串。
Public Function CreateDataRsFieldDescString(ByRef rs As ADODB.Recordset, ByVal isOneLine As Boolean) As String
    Dim fld As ADODB.field
    Dim s As String
    
    For Each fld In rs.Fields
        If s <> "" Then
            If isOneLine = True Then
                s = s & "," & String(10, " ")
            Else
                s = s & ", "" & _" & vbCrLf & """"
            End If
        End If
        s = s & fld.Name & "," & fld.Name & ",True," & fld.Type & ","
        ''中文,英文,true,122,String,ReportName
        Select Case fld.Type
        Case ADODB.adVarChar
            s = s & "String"
        Case ADODB.adNumeric, ADODB.adInteger, ADODB.adDouble
            s = s & "Number"
        Case ADODB.adDate, ADODB.adDBDate
            s = s & "DateTime"
        Case Else
            s = s & "String"
        End Select
        s = s & ",Default"
    Next
    CreateDataRsFieldDescString = s
End Function

'去null值,模仿 VBA 的NZ 函数
Private Function VB6Nz(ByVal v As Variant, ByVal defaultValue As Variant) As Variant
    If IsNull(v) = True Then
        VB6Nz = defaultValue
    Else
        VB6Nz = v
    End If
End Function
Private Function RsToXls(ByRef rs As ADODB.Recordset, ByVal filename As String)
    Dim i As Long
    Dim i2 As Long
On Error GoTo RsToRs_Err
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.OpenTextFile(filename, 8, True)
    Dim s As String
    Dim s3 As String
    Dim sr As String
    Dim blnCancel As Boolean
    
    For i = 0 To rs.Fields.Count - 1
        Debug.Print FieldProperty(rs.Fields(i).Name, eepVisible)
        If FieldProperty(rs.Fields(i).Name, eepVisible) = "True" Then
            s = AddTag(CheckXmlString(FieldProperty(rs.Fields(i).Name, eepChs)), "Data", "String")
            s = AddTag(s, "Cell")
            sr = sr & s
        End If
    Next
    sr = AddTag(sr, "Row")
   
    s3 = strXlsHead & sr
        
    Do Until rs.EOF
        sr = ""
        s = ""
        i2 = i2 + 1
        For i = 0 To rs.Fields.Count - 1
            If blnStop = True Then
                dblEndTimer = Timer()
                RaiseEvent ProcessStop(i2, rs.recordCount, dblEndTimer - dblStartTimer, "用户手动停止操作。")
                Exit Function
            End If
            '触发事件
            dblEndTimer = Timer()
            RaiseEvent Exporting(i2, rs.recordCount, dblEndTimer - dblStartTimer, rs, rs.Fields(i), blnCancel)
            If blnCancel = False Then
                If FieldProperty(rs.Fields(i).Name, eepVisible) = "True" Then
                    Select Case rs.Fields(i).Type
                    Case ADODB.adVarChar
                        s = AddTag(CheckXmlString(rs.Fields(i).Value), "Data", "String")
                        s = AddTag(s, "Cell")
                    Case ADODB.adNumeric, ADODB.adInteger, ADODB.adDouble
                        s = AddTag(VB6Nz(rs.Fields(i).Value, ""), "Data", "Number")
                        s = AddTag(s, "Cell")
                    Case ADODB.adDate, ADODB.adDBDate
                        '注意 EXCEL XML 中日期是特殊的,以 2010-09-10T16:55:47.071 这样的格式保存。
                        If IsDate(rs.Fields(i).Value) = True Then
                            s = AddTag(Format(rs.Fields(i).Value, "YYYY-MM-DDTHH:NN:SS"), "Data", "DateTime")
                            '注意!日期比较特别,其有特定格式,该格式是 head 中styles标记中特别定义的。
                            s = AddTag(s, "Cell", , "clsRecordsetToXlsDatetime")
                        Else
                            s = AddTag(CheckXmlString(VB6Nz(rs.Fields(i).Value, "")), "Data", "String")
                            s = AddTag(s, "Cell")
                        End If
                    Case Else
                        s = AddTag(CheckXmlString(rs.Fields(i).Value), "Data", "String")
                        s = AddTag(s, "Cell")
                    End Select
                    
                    sr = sr & s
                    DoEvents
                End If
            End If
        Next
        sr = AddTag(sr, "Row")
        sr = sr & vbCrLf
        s3 = s3 & sr
        DoEvents
        If blnStop = True Then
            dblEndTimer = Timer()
            RaiseEvent ProcessStop(i2, rs.recordCount, dblEndTimer - dblStartTimer, "用户手动停止操作。")
            Exit Function
        End If
        
        If Len(s3) > STRING_PAGESZIE Then
            a.write s3
            s3 = ""
        End If
        
        rs.MoveNext
    Loop
        
    a.write s3 & strXlsFoot
    a.Close
    
    
    dblEndTimer = Timer()
    RaiseEvent ProcessEnd(i2, dblEndTimer - dblStartTimer, True, "成功。")
    
    Exit Function
    
RsToRs_Err:
    dblEndTimer = Timer()
    If Err <> 0 Then
        RaiseEvent ProcessEnd(i2, dblEndTimer - dblStartTimer, False, Err.Number & Err.Source & Err.Description)
    End If
        
End Function

Private Function ReadHead()
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.OpenTextFile(CurrentProject.Path & "\head.txt", 1)
    Dim s As String
    s = a.readall
    a.Close
    ReadHead = s
End Function
Private Function ReadFoot()
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.OpenTextFile(CurrentProject.Path & "\foot.txt", 1)
    Dim s As String
    s = a.readall
    a.Close
    ReadFoot = s
End Function


Private Sub Class_Initialize()
    dblStartTimer = Timer()
    
    strXlsHeadDefault = "<?xml version=""1.0"" [encoding property]?><?mso-application progid=""Excel.Sheet""?><Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet"" xmlns:o=""urn:schemas-microsoft-com:office:office"" xmlns:x=""urn:schemas-microsoft-com:office:excel"" xmlns:ss=""urn:schemas-microsoft-com:office:spreadsheet""  xmlns:html=""http://www.w3.org/TR/REC-html40"">  <ExcelWorkbook xmlns=""urn:schemas-microsoft-com:office:excel"">   </ExcelWorkbook>  <Styles> <Style ss:ID=""clsRecordsetToXlsDatetime"">  <NumberFormat ss:Format=""yyyy/m/d;@""/>  </Style> </Styles> <Worksheet ss:Name=""Sheet1"">   <Table>"
    strXlsFoot = "</Table></Worksheet></Workbook>"
    '默认值
    Me.XlsEncoding = "GB2312"
    
End Sub



调用方法1,支持进度提示,工作中途停止导出。
建立一个包含3个控件的窗体

Option Compare Database
'新建一个窗体,窗体,窗体上至少有3个控件:2个按钮和1个标签。
'1个开始按钮,1个结束按钮(用于长时间处理时可以在处理到一半停止),1个标签(用于显示处理信息)
'以下代码调用类的事件来完成与用户的交互。

Dim WithEvents rts As clsRecordsetToXls

'开始执行按钮
Private Sub Command5_Click()
    
    Set rts = New clsRecordsetToXls
    
    
'    '1 直接从内存中获取参数表的方法
'    Dim rs As New ADODB.Recordset
'    '字段描述字符串格式如下:中文,英文,true,122,String,ReportName
'    '用户可以直接用:rts.CreateDataRsFieldDescString(rsData, False) 来创建字段表述。
'    ''rts.CreateParametersRs "字段1,字段1,true,200,String,x,  字段2,字段2,true,200,String,x,  字段2,字段2,true,200,String,x   ", rs
'    rts.CreateParametersRs "编号,编号,True,3,Number,Default, " & _
'        "字段1,字段1,True,202,String,Default, " & _
'        "字段2,字段2,True,202,String,Default, " & _
'        "字段3,字段3,True,202,String,Default, " & _
'        "日期字段,日期字段,True,7,DateTime,Default", rs
'    Set rts.ParaRs = rs
'    Debug.Print "是否从内存中获取参数:", rts.IsParaFromRs
    
    '2 直接从数据库中获取参数表的方法
    rts.ReportName = "InOutCountReport"
    Set rts.ActiveConnection = CurrentProject.Connection
    Debug.Print "是否从内存中获取参数:", rts.IsParaFromRs

    rts.XlsEncoding = "GB2312"
    rts.XlsFullPath = CurrentProject.Path & "\a.xml"
    
    '判断导出的文件名是否已经存在,如果已经存在则先删除。
    If Dir(CurrentProject.Path & "\a.xml") <> "" Then
        Kill CurrentProject.Path & "\a.xml"
    End If
    
    '将数据表赋给导出类的DataRs属性
    Dim rsData As New ADODB.Recordset
    rsData.Open "select * from sheet1", CurrentProject.Connection, 1, 1
    Set rts.DataRs = rsData
    '执行导出
    rts.DoExport
    rsData.Close
    
End Sub

'停止按钮
Private Sub Command8_Click()
    rts.ProcesStop = True
End Sub

'正在进行的时候触发的事件
Private Sub rts_Exporting(ByVal currentRow As Long, _
    ByVal recordCount As Long, _
    ByVal currentTimer As Double, _
    rs As ADODB.Recordset, _
    field As ADODB.field, cancel As Boolean)
    
    Me.lblMsg.Caption = "处理进度:" & currentRow & "/" & recordCount & "。"
    Me.Repaint
End Sub

'全部结束后触发的事件
Private Sub rts_ProcessEnd(ByVal currentRow As Long, _
    ByVal currentTimer As Double, _
    ByVal successed As Boolean, _
    ByVal msg As String)
    
    If successed = True Then
        Me.lblMsg.Caption = "完成。" & msg & "耗时:" & currentTimer & "秒。"
    Else
        Me.lblMsg.Caption = "完成,但出现错误:" & msg & "目前处理到:" & currentRow & "行。耗时:" & currentTimer & "秒。"
    End If
    Me.Repaint
End Sub

Private Sub rts_ProcessStop(ByVal currentRow As Long, ByVal recordCount As Long, ByVal currentTimer As Double, msg As String)
    Me.lblMsg.Caption = "用户手动停止了操作。目前操作到第" & currentRow & "行,总共" & recorcount & "行。耗时:" & currentTimer & "。" & msg
    Me.Repaint
End Sub


调用方法2,不支持进度提示:
建立一个模块


'在模块中直接调用clsRecordsetToXls类的示例。
'模块中调用不能订阅事件来获取进度。
Function test2()
    Dim rts As New clsRecordsetToXls
    
    '1 直接从内存中获取参数表的方法
    Dim rs As New ADODB.Recordset
    '字段描述字符串格式如下:中文,英文,true,122,String,ReportName
    '用户可以直接用:rts.CreateDataRsFieldDescString(rsData, False) 来创建字段表述。
    'rts.CreateParametersRs "字段1,字段1,true,200,String,x,  字段2,字段2,true,200,String,x,  字段2,字段2,true,200,String,x   ", rs
    rts.CreateParametersRs "编号,编号,True,3,Number,Default, " & _
        "字段1,字段1,True,202,String,Default, " & _
        "字段2,字段2,True,202,String,Default, " & _
        "字段3,字段3,True,202,String,Default, " & _
        "日期字段,日期字段,True,7,DateTime,Default", rs
    Set rts.ParaRs = rs
    Debug.Print "是否从内存中获取参数:", rts.IsParaFromRs
    
'    '2 直接从数据库中获取参数表的方法
'    rts.ReportName = "???"
'    Set rts.ActiveConnection = CurrentProject.Connection
'    Debug.Print "是否从内存中获取参数:", rts.IsParaFromRs

    rts.XlsEncoding = "GB2312"
    rts.XlsFullPath = CurrentProject.Path & "\a.xml"
    
    
    
    '将数据表赋给导出类的DataRs属性
    Dim rsData As New ADODB.Recordset
    rsData.Open "select * from ado", CurrentProject.Connection, 1, 1
    Set rts.DataRs = rsData
    '执行导出
    rts.DoExport
    rsData.Close
    
    
End Function

'创建一个参数表,该参数表用来存放字段名(列名)等描述信息。
Function test3()
    Dim rts As New clsRecordsetToXls
    Set rts.ActiveConnection = CurrentProject.Connection
    rts.CreateExportParaTable
End Function


示例下载:http://access911.net/down/eg/eg_RecordsetExportToExcel.rar
(101KB)

 


本站文章旨在为该问题提供解决思路及关键性代码,并不能完成应该由网友自己完成的所有工作,请网友在仔细看文章并理解思路的基础上举一反三、灵活运用。

access911.net 原创文章,作者本人对文章保留一切权利。
如需转载必须征得作者同意并注明本站链接


 

 
相关文章
     没有手动相关文章
 
评论
     查看或发表更多的评论,请单击这里。
 
 
 
 
 
   
  Access911.net   |   a9BBS   |   OTaA System   |
建站日期:2000年4月2日  |  设计施工:陈格 ( access911 & cg1 )
 Copyright © 2000 - 2003 COMET, 陈格 保留所有权利