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
