如何用CopyFromRecordset将窗体内容导出到excel表中

简

因为记录成千上万，到月底将数据表中的内容导出到excel时，如果采用ADO+for……next循环的方式，则速度非常慢，有朋友给我介绍说用CopyFromRecordset代码，可以提高速度。查了资料来看，帮助上关于CopyFromRecordset的介绍都非常简单，实例也很少，todaynew老汉的计划生育例子虽然是关于CopyFromRecordset的，但他的例子太复杂，让我不能完全看个明白。其实
CopyFromRecordset代码我不能明白的地方就在于MaxRows, MaxColumns上。如果我要指定行数，指定导出的列，CopyFromRecordset代码应该怎么写呢。

比如说，在附件的数据库中，我希望把子窗体的数据导出到excel表1中。excel表1的样式我都设置好了，我现在只需要把子窗体中的机床，产品代号，姓名，完成数量，金额这几个字段的内容导出，这时CopyFromRecordset代码该怎么写呢。导出后，我需要把excel表1中第三行的格式应用到后面的记录中，这又该怎么处理呢。

pq318

Henry版主给我的，不需任何附属的东西，一个按钮单击事件搞定，我已经实际检验过
OutputTo 方法

请参阅 应用于 示例 特性

OutputTo 方法在 Visual Basic 中执行 OutputTo 操作。



expression.OutputTo(ObjectType, ObjectName, OutputFormat, OutputFile, AutoStart, TemplateFile, Encoding)



expression   必需。返回 DoCmd 对象的表达式。



ObjectType  AcOutputObjectType，必需。代表要输出的对象的类型。



AcOutputObjectType 可以是下列 AcOutputObjectType 常量之一：

acOutputDataAccessPage  不支持。

acOutputForm

acOutputFunction

acOutputModule

acOutputQuery

acOutputReport

acOutputServerView

acOutputStoredProcedure

acOutputTable



ObjectName  Variant 型，可选。字符串表达式，代表由 ObjectType 参数所选择的类型的对象的有效名称。如果要输出活动的对象，可将 ObjectType 参数指定为对象的类型，并将该参数留空。如果在某个类库数据库中运行包含 OutputTo 方法的 Visual Basic 代码，Microsoft Access 将首先在该类库数据库中，搜索具有该名称的对象，然后再到当前数据库中搜索。



OutputFormat  Variant 型，可选。输出格式，以 AcFormat 常量的形式表示。如果省略该参数，Microsoft Access 将提示您指定输出格式。



AcFormat 可以是下列 AcFormat 常量之一：

acFormatASP

acFormatDAP

acFormatHTML

acFormatIIS

acFormatRTF

acFormatSNP

acFormatTXT

acFormatXLS



OutputFile  Variant 型，可选。字符串表达式，代表对象要输出到的文件的完整名称（包括路径）。如果将该参数留空，Microsoft Access 将提示您指定输出文件名。



AutoStart  Variant 型，可选。该参数为 True (-1) 可立刻启动适当的基于 Microsoft Windows 的应用程序，并加载由 OutputFile 参数指定的文件。如果不想启动该应用程序，可将该参数设为 False (0)。对于 Microsoft Internet Information Server （.htx、.idc）文件和 Microsoft ActiveX Server 文件 (*.asp)，将忽略该参数。如果将该参数留空，就会采用默认值 (False)。



TemplateFile  Variant 型，可选。字符串表达式，代表要用作 HTML、HTX 或 ASP 文件的模板的文件的完整名称（包括路径）。



Encoding  Variant 型，可选。



说明

有关该操作及其参数如何工作的详细信息，请参阅该操作的主题。



模块只能输出 MS-DOS 文本格式，所以如果将 ObjectType 参数指定为 acOutputModule，则必须将 OutputFormat 参数指定为 acFormatTXT。Microsoft Internet Information Server 和 Microsoft ActiveX Server 格式只能用于表、查询及窗体，所以如果将 OutputFormat 参数指定为 acFormatIIS 或 acFormatASP，则必须将 ObjectType 参数指定为 acOutputTable、acOutputQuery 或 acOutputForm。



可以将语法中的可选参数留空，但必须包含参数的逗号。如果将位于末端的参数留空，则在指定的最后一个参数后面不需使用逗号。



示例

下面的示例将 RTF 格式的“Employees”表输出到“Employee.rtf”文件，并立即在 Microsoft Word for Windows 中打开该文件。



DoCmd.OutputTo acOutputTable, "Employees", _

    acFormatRTF, "Employee.rtf", True

简

pq318 发表于 2012-5-8 22:54
Henry版主给我的，不需任何附属的东西，一个按钮单击事件搞定，我已经实际检验过
OutputTo 方法

我用过outputTo方法，但其不足之处我曾发过帖子，即http://www.office-cn.net/thread-108990-1-1.html。

Grant

这个应该简单了

On Error GoTo errit

Dim oExcel As Object
Dim oBook As Object
Dim I As Integer
   
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add()
   
   Me.子窗体.Form.Recordset.MoveFirst
   
   For I = 0 To Me.子窗体.Form.Recordset.Fields.Count - 1
      oBook.Worksheets(1).Cells(1, I + 1).Value = Me.子窗体.Form.Recordset.Fields(I).Name
   Next

   oBook.Worksheets(1).Range("A2").CopyFromRecordset Me.子窗体.Form.Recordset
   oBook.SaveAs ("d:\Test.xls")
   MsgBox "导出成功"

errexit:
   oBook.Close False
   oExcel.Quit
   Set oBook = Nothing
   Set oExcel = Nothing
   Exit Sub

errit:
   MsgBox "错误号为" & Err.Number & " 错误说明：" & Err.Description
   Resume errexit


************************
很好,其实改为通用函数岂不更好?

Public Sub rs2xls(rs As Object)
'将子窗体记录复制到XLS中
On Error GoTo errit
'set rs = Me.子窗体.Form.Recordset
Dim oExcel As Object
Dim oBook As Object
Dim I As Integer
   
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add()
   
   rs.MoveFirst
   
   For I = 0 To rs.Fields.Count - 1
      oBook.Worksheets(1).Cells(1, I + 1).Value = rs.Fields(I).Name
   Next

   oBook.Worksheets(1).Range("A2").CopyFromRecordset rs
   oBook.SaveAs ("C:\Book1.xls")
   MsgBox "导出成功"
'打開文件時用到.

'ShellExecute Application.hWndAccessApp, "Open", "d:\Test.xls", "", "d:\", SW_NORMAL

errexit:
   oBook.Close False
   oExcel.Quit
   Set oBook = Nothing
   Set oExcel = Nothing
   Exit Sub

errit:
   MsgBox "错误号为" & Err.Number & " 错误说明：" & Err.Description
   Resume errexit

End Sub

然后在窗体中调用即可:


Private Sub Command1_Click()
rs2xls subfrm.Form.Recordset   '子窗体: subfrm
End Sub


******************************************
Public Sub OutputSubForm(frmMainForm As Form, frmSubFormName As String)
'*****************************************************
'使用示例：OutputSubForm Me, Me.订单子窗体.Name
'http://www.accfans.net 李寻欢
'2005-08-16
'******************************************************
Dim strSql As String
Dim strRecordSource As String
Dim strLinkChildfields As String
Dim strLinkMasterFields As String
Dim strFilter As String
Dim blnFilterOn As Boolean
Dim strLinkSQL As String
Dim Rs As Recordset
Dim Qd As QueryDef

On Error GoTo Outputerr:
Set Rs = frmMainForm.Controls(frmSubFormName).Form.RecordsetClone
Set Qd = CurrentDb.CreateQueryDef("qryTemp")

strRecordSource = frmMainForm.Controls(frmSubFormName).Form.RecordSource
strLinkChildfields = frmMainForm.Controls(frmSubFormName).LinkChildFields
strLinkMasterFields = frmMainForm.Controls(frmSubFormName).LinkMasterFields
strFilter = frmMainForm.Controls(frmSubFormName).Form.Filter
blnFilterOn = frmMainForm.Controls(frmSubFormName).Form.FilterOn

If strLinkChildfields <> "" Then
    Select Case Rs.Fields(strLinkChildfields)
    Case dbChar
        strLinkSQL = strLinkChildfields & "='" & frmMainForm.Controls(strLinkMasterFields) & "'"
    Case Else
        strLinkSQL = strLinkChildfields & "=" & frmMainForm.Controls(strLinkMasterFields)
    End Select
End If

If blnFilterOn = True Then
    If strLinkSQL <> "" Then
        strLinkSQL = strLinkSQL & " and " & strFilter
    Else
        strLinkSQL = strFilter
    End If
End If

If InStr(strRecordSource, "Select ") > 0 Then
    strSql = Left(strRecordSource, Len(strRecordSource) - 2)
Else
    strSql = "Select * From " & strRecordSource
End If

If InStr(strRecordSource, " where ") > 0 Then
    If strLinkSQL <> "" Then
        strSql = strSql & " and " & strLinkSQL
    End If
Else
    If strLinkSQL <> "" Then
        strSql = strSql & " where " & strLinkSQL
    End If
End If
Qd.SQL = strSql
DoCmd.OutputTo acOutputQuery, "qryTemp"
DoCmd.DeleteObject acQuery, "qryTemp"
Rs.Close
Set Rs = Nothing

Exit Sub

Outputerr:
    Rs.Close
    Set Rs = Nothing
    If IsNull(Dlookup("[Name]", "MSysObjects", "[Name] = 'qryTemp'")) = False Then
         DoCmd.DeleteObject acQuery, "qryTemp"
    End If
    MsgBox Err.Description
End Sub

调用方法：
Private Sub Command5_Click()
OutputSubForm Me, Me.表1子窗体.Name
End Sub

简

roych 发表于 2012-5-9 08:57
附上简单代码一段：

roych，我把你的代码应用在我的数据库中，

我的代码是：
    Dim rst         As New ADODB.Recordset   
      dim ssql        As string

      ssql = "select 机床,产品代号,姓名,完成数量,金额,产品代号 from qryhz"
      rst.Open ssql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

      qryhz是交叉表查询。


在这段代码里出现问题，rst.Open ssql,CurrentProject.Connection, adOpenKeyset中显示运行时错误，-2147217904，至少一个参数没有被指定。

是不是ssql不适用于交叉报表呢。

简

Grant 发表于 2012-5-9 00:03
这个应该简单了

On Error GoTo errit

GRANT，我想用CopyFromRecordset导出指定的列，那又怎么办呢，你导出的是所有列呢。

roych

附上简单代码一段：

1. Private Sub cmd1_Click()
   
2. '需引用Excel 12.0库
   
3. '否则应该通过CreateObject方法来创建Excel组件
   
4. Dim rst As New ADODB.Recordset
   
5. Dim wk As Workbook
   
6. Dim ws As Worksheet
   
7. rst.Open "select 机床,产品代号,姓名,完成数量,金额 from AA", CurrentProject.Connection, adOpenKeyset
   
8. Set wk = Workbooks.Open(CurrentProject.Path & "\表1.xlt")
   
9. Set ws = wk.Sheets("sheet1")
   
10. ws.Activate
    
11. 'MaxRows表示需要导出前5条记录，MaxColumns表示导出前5个字段
    
12. '其实这两个属性一般很少用，因为记录集通常都是已处理好的了
    
13. ws.Range("A3").CopyFromRecordset rst, 5, 5 '
    
14. '关闭模板，默认为覆盖源文件，以便不弹出提示。
    
15. '弹出一个另存为对话框。
    
16. wk.Close True
    
17. End Sub

复制代码

roych

简 发表于 2012-5-9 12:46
roych，我把你的代码应用在我的数据库中，

我的代码是：

ssql = "select 机床,产品代号,姓名,完成数量,金额,产品代号 from qryhz"

跟交叉表应该没关系，但你这里有两个相同的字段（产品代号）~~可能是之前贴代码时出了点小故障，你受到影响了~~~
不过有一点是需要注意的，交叉表中的“值字段”是不会被导出的。如果需要合计的话，建议以交叉表为数据源新建一个查询再做进一步处理。

ycxchen

简的钻研精神值得学习！

简

我可能晓得为什么我的ssql出错的原因，老是提示参数不足，可能跟我查询中的参数有关吧，如图所示。



像这种情况，又如何写代码呢。