Office中国论坛/Access中国论坛

标题: 【原创 / 源码】导出窗体Recordset为任意Access支持格式的数据文件 [打印本页]

作者: LucasLynn 时间: 2005-8-16 22:21
标题: 【原创 / 源码】导出窗体Recordset为任意Access支持格式的数据文件
以下代码将DAO的RecordSet（包括Access窗体的Recordset）中的当前数据导出为任何Access支持的导出格式。无论你这个Recordset是从窗体的，还是代码创建的，是筛选后结果，还是链接了字段的主窗体，本程序均能正确导出结果，格式包括任何Access支持的导出格式。

备注：数据类型转换的部分可能还会有些小问题，如果有谁使用中发现导出后数据格式错误请告诉我，便于我改进。

（2006年5月13日修改，增加了取消导出的异常处理）

'调用范例

Private Sub Botton_Click()
Call Output_Recordset(Me.Recordset)
End Sub

<DIV class=quote>

'公共模块

Option Compare Database
Option Explicit

Public Sub Output_Recordset(ByRef frmRs As DAO.Recordset)
Dim frmField As DAO.Field
Dim daoDbs As DAO.Database
Dim daoRs As DAO.Recordset

Dim strSQL As String
Dim strFields As String

Set daoDbs = Application.CurrentDb
Set daoRs = frmRs.Clone

strSQL = "CREATE TABLE USysDAORecordsetOutport"
strFields = "("

For Each frmField In daoRs.Fields
      strFields = strFields & frmField.Name & " "
      Select Case frmField.Type
         Case dbBigInt:
            strFields = strFields & "Currency"
         Case dbBinary:
            strFields = strFields & "Binary"
         Case dbBoolean:
            strFields = strFields & "Bit"
         Case dbByte:
            strFields = strFields & "TinyInt"
         Case dbChar:
            strFields = strFields & "Char"
         Case dbCurrency:
            strFields = strFields & "Money"
         Case dbDate:
            strFields = strFields & "DateTime"
         Case dbDecimal:
            strFields = strFields & "Decimal"
         Case dbDouble:
            strFields = strFields & "Double"
         Case dbFloat:
            strFields = strFields & "Float"
         Case dbGUID:
            strFields = strFields & "Guid"
         Case dbInteger:
            strFields = strFields & "Integer"
         Case dbLong:
            strFields = strFields & "Long"
         Case dbLongBinary:
            strFields = strFields & "LongBinary"
         Case dbMemo :
            strFields = strFields & "Memo"
         Case dbNumeric:
            strFields = strFields & "Numeric"
         Case dbSingle:
            strFields = strFields & "Single"
         Case dbText:
            strFields = strFields & "Text(" & frmField.Size & ")"
         Case dbTime:
            strFields = strFields & "Time"
         Case dbTimeStamp:
            strFields = strFields & "DateTime"
         Case dbVarBinary:
            strFields = strFields & "VarBinary"
      End Select

      strFields = strFields & ","
Next frmField
strFields = Left(strFields, Len(strFields) - 1) & ")"

On Error Resume Next
      daoDbs.Execute "DROP TABLE USysDAORecordsetOutport"
On Error GoTo 0
daoDbs.Execute strSQL & strFields

daoRs.MoveFirst

Do Until daoRs.EOF
      strSQL = "INSERT INTO USysDAORecordsetOutport("
      strFields = " Values("
      For Each frmField In daoRs.Fields
         If Not IsNull(frmField.Value) And Not IsEmpty(frmField.Value) Then
            strSQL = strSQL & frmField.Name & ","
            If frmField.Type = dbText Then
                  strFields = strFields & "'" & frmField.Value & "',"
            Else
                  strFields = strFields & frmField.Value & ","
            End If
         End If
      Next frmField

作者: zhengjialon 时间: 2005-8-16 22:22
不错的说,能否改成ADO的?

作者: LucasLynn 时间: 2005-8-16 22:24

以下是引用zhengjialon在2005-8-16 14:22:00的发言：

不错的说,能否改成ADO的?

问题不大，小改几行就可以，主要是因为原来为导出子窗体内数据，所以采用了Access的DAO方式，这样窗体Recordset就能直接送进去。

本来想做个同时支持ADO和DAO的，但是不知道该怎么来定义这个子程序的参数类型，哪位能提醒一下？我试过AccessObject和Object都出错。

[此贴子已经被作者于2005-8-16 14:31:38编辑过]

作者: 红寺 时间: 2005-8-16 23:51
好东西,不过还没试

作者: LucasLynn 时间: 2005-8-17 01:03
重新贴了一下代码，修正了几个BUG：

1、是/否类型的值导出

2、空值导出

3、多数据条目导出

作者: secowu 时间: 2005-8-17 01:46
好东西，效果很棒非常感谢分享谢谢

作者: LucasLynn 时间: 2005-8-17 02:19
再次更新了代码，解决了一个导致效率低的重大原因……

那就是Debug.Print……

原来这个语句这么影响效率……

作者: LucasLynn 时间: 2005-8-18 00:30
晕，这个程序不算太滥吧，这么快就沉了……

作者: wu8313 时间: 2005-8-18 18:37

以下是引用LucasLynn在2005-8-17 16:30:00的发言：

晕，这个程序不算太滥吧，这么快就沉了……

我想，不是太滥，而是曲高和寡。能有实例，不会沉掉。

作者: LucasLynn 时间: 2005-8-18 18:42

以下是引用wu8313在2005-8-18 10:37:00的发言：

我想，不是太滥，而是曲高和寡。能有实例，不会沉掉。

这个实例……这个程序已经做成了公共子程序，实例顶多也就是个调用而已……

算了，补充一个吧。

作者: tmtony 时间: 2005-8-18 19:28
很不错的代码!

作者: wu8313 时间: 2005-8-19 01:23
过程已经放在了窗体模块，我进行如下调用：

Call Output_Recordset(Me.子窗体.Form.Recordset)

编译没有问题，可是出现运行时错误：

字段定义语法错误。

[attach]12532[/attach]

[此贴子已经被作者于2005-8-18 17:26:05编辑过]

作者: esmile 时间: 2005-8-19 09:32
提示: 作者被禁止或删除内容自动屏蔽

作者: LucasLynn 时间: 2005-8-19 16:07

以下是引用wu8313在2005-8-18 17:23:00的发言：

过程已经放在了窗体模块，我进行如下调用：

Call Output_Recordset(Me.子窗体.Form.Recordset)

编译没有问题，可是出现运行时错误：

字段定义语法错误。

麻烦您把文件传上来，我调试一下看看问题出在哪里。

作者: LucasLynn 时间: 2005-8-19 16:07

以下是引用esmile在2005-8-19 1:32:00的发言：

钟对备注型的字段出错,

必须将: Case dbMem

strFields = strFields & "Memo"

改为:

Case dbMem　,12 ＇esmile add

strFields = strFields & "Memo"

12？

这么改为什么？

作者: wu8313 时间: 2005-8-20 01:41
LucasLynn：

在“分类与搜索”这个窗体中，有一个按钮使用您的代码。为减小体积，我删掉了一些表和窗体，但需要导出的部分留下来了，不影响导出。[attach]12565[/attach]

[此贴子已经被作者于2005-8-19 17:41:49编辑过]

作者: LucasLynn 时间: 2005-8-20 03:41
上面两位提到的问题我已经找到了原因，论坛上的源码的确有误，但是并不是我写错了，而是BBS系统好像对o和:连在一起敏感，我原来的代码是：

Case dbMemo :

结果贴出来成了：

Case dbMem

编辑了很多次都一样，最后我在o和:之间添加了一个空格，才正常显示。

我已经更新了源码，现在应该没有问题了。

[此贴子已经被作者于2005-8-19 19:42:29编辑过]

作者: secowu 时间: 2005-8-20 21:33
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'调用范例

Private Sub Botton_Click()

Call Output_Recordset(Me.Recordset)

End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

这样才像样：

要不，普通人很难消解高手的代码的

第一：

   告诉他，你的模块是做什么的，有什么好处

第二：

   别告诉他你的模块的运作原理

第三：

      告诉他怎么调用

   ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

      》》》》》》》》》》》》》》》》》》》》》》》》》》》》》

      这就是MAC OS 到 WINDWOS 的转变

      阳春白雪  到下里巴人的转变

            牧人，有没道理呀

[此贴子已经被作者于2005-8-20 13:36:12编辑过]

作者: LucasLynn 时间: 2005-8-20 21:50

以下是引用secowu在2005-8-20 13:33:00的发言：

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'调用范例

Private Sub Botton_Click()

Call Output_Recordset(Me.Recordset)

End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

这样才像样：

要不，普通人很难消解高手的代码的

第一：

   告诉他，你的模块是做什么的，有什么好处

第二：

   别告诉他你的模块的运作原理

第三：

      告诉他怎么调用

   ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

      》》》》》》》》》》》》》》》》》》》》》》》》》》》》》

      这就是MAC OS 到 WINDWOS 的转变

      阳春白雪  到下里巴人的转变

            牧人，有没道理呀

我只是觉得，Recordset已经是很基本的概念了，Access开发者至少应该知道Recordset是什么，和窗体的Recordset在哪里吧？

作者: aaquick 时间: 2006-3-10 14:07
试了一下，出现”用户定义类型未定义“的错误，是不是还要引用什么类库？

作者: aone 时间: 2006-4-15 22:34
以前导出子窗体筛选记录的时候总是需要在多做一个过渡查询！好帖！谢谢分享，学习中！

作者: videochat 时间: 2006-5-11 23:33
厉害啊，啥时候偶能写出来啊

谢谢

作者: zouwen 时间: 2006-9-16 07:39
标题: 找出有错误了
我在导出有十几个字段,记录有1万-40万条时会出错处理几条记录不会出错

运行是错误'3075'

语法错误(操作符丢失)在'2005-7-19 9:03:31'

进入调试后

Do Until daoRs.EOF
      strSQL = "INSERT INTO USysDAORecordsetOutport("
      strFields = " Values("
      For Each frmField In daoRs.Fields
         If Not IsNull(frmField.Value) And Not IsEmpty(frmField.Value) Then
            strSQL = strSQL & frmField.Name & ","
            If frmField.Type = dbText Then
                  strFields = strFields & "'" & frmField.Value & "',"
            Else
                  strFields = strFields & frmField.Value & ","
            End If
         End If
      Next frmField
      strSQL = Left(strSQL, Len(strSQL) - 1) & ")"
      strFields = Left(strFields, Len(strFields) - 1) & ")"

      daoDbs.Execute strSQL & strFields    这一行是黄色

      daoRs.MoveNext
Loop

On Error Resume Next
      DoCmd.OutputTo acOutputTable, "USysDAORecordsetOutport"
On Error GoTo 0

daoDbs.Execute "DROP TABLE USysDAORecordsetOutport"

End Sub

作者: zouwen 时间: 2006-9-17 16:02
标题: 导出类型有问题
当记录有 ' / 字符号时导出会出错

作者: maple99 时间: 2007-8-25 12:17
很不错的代码! 多学习

作者: 5988143 时间: 2007-8-25 13:29

原帖由 zouwen 于 2006-9-17 16:02 发表
当记录有 ' / 字符号时导出会出错

是的,好像定義為時間類型時會出錯,請作者再跟進哈!

作者: 西湖渔夫 时间: 2009-6-1 16:46
公共模块代码不全，怎么办？

作者: sunwrsun 时间: 2009-7-26 14:05

作者: chaojianan 时间: 2009-10-24 15:22
谢谢，收藏了。

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)