导出每一行都带字段名的记录到EXCEL

t小宝

看到导出工资表要每一条记录都有标题的帖子http://www.office-cn.net/forum.php?mod=viewthread&tid=56429&extra=page%3D1，深有同感，于是做了这个函数，抛砖引玉 。欢迎大家指正和测试

使用举例：f导出带字段名的记录1 "工资表","月份='7'","E:\导出\导出工资表.xls"

Public Function f导出带字段名的记录1(s表名 As String, s条件 As String, s目标 As String) As Boolean
'此函数用联合查询实现每条记录都带有字段名，再用新建表查询一次性导出到Excel
'参数说明：
    '1.s表名 - 要导出记录的表或查询的名称
    '2.s条件 - 导出记录的限制条件，如"姓名='韦小宝'"
    '3.s目标 - 电子表格文件名称(包含路径如"E:\表格\导出工资表.xls")，路径要先建好，但表格文件不要与已有的相同
   
'注意！导出太多记录会出错！因变量和查询均有字数限制，具体是多少没试过……谁知道麻烦告诉我一下啦……
'此函数的优点是不用临时表，不用操纵EXCEL实现，记录带字段名的导出，速度较快，缺点是导出的数据全部变成文本型
'--------------------------------------------t小宝(2007-8-20)tcl013@126.com-----------------------------------------------
On Error GoTo Err_1

Dim dbs As DAO.Database
Dim r源表 As DAO.Recordset
Dim i As Integer
Dim s字段名 As String
Dim s字段值 As String
Dim s联合 As String

Set dbs = CurrentDb
Set r源表 = dbs.OpenRecordset("Select * From " & s表名 & IIf(Len(s条件) > 2, " Where " & s条件, ""))

' 组合联合查询字符串
With r源表
    If .EOF Then Exit Function
    For i = 0 To .Fields.Count - 1
        s字段名 = s字段名 & .Fields(i).Name & "','"
    Next
    s字段名 = "Select TOP 1 '" & Left(s字段名, Len(s字段名) - 2) & " From " & s表名

    Do Until .EOF
        For i = 0 To .Fields.Count - 1
            s字段值 = s字段值 & .Fields(i) & "' As " & .Fields(i).Name & ",'"
        Next
        s字段值 = "Select  TOP 1 '" & Left(s字段值, Len(s字段值) - 2) & " From " & s表名
        s联合 = s联合 & s字段值 & " UNION ALL " & s字段名 & " UNION ALL "
        s字段值 = ""
        .MoveNext
    Loop

    .Close
End With
s联合 = Left(s联合, Len(s联合) - Len(s字段名) - 22)

' 新建电子表格
dbs.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & s目标 & "].Sheet1 FROM (" & s联合 & ")"

f导出带字段名的记录1 = True
Set r源表 = Nothing
Set dbs = Nothing

Exit_1:
    Exit Function
Err_1:
    MsgBox Err.Description
    Resume Exit_1
   
End Function

例子数据库：


[ 本帖最后由 t小宝 于 2007-8-20 21:54 编辑 ]

lnlyhsn

踩踩 看看

clmkjszx123

xxxxxxxxxxxxx

goto2008

如果能把这个问题：表格文件不要与已有的相同------修复一下。。。就更好了。。。

huangqinyong

思路不错，．．．．．．．．．．．

rcylbx

谢谢分享

5988143

谢谢分享

goto2008

谢谢分享。。。。。。

wang1950317

试过，不错的函数，谢谢分享！

tmtony

不错, 谢谢分享!!