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

简

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

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

todaynew

简 发表于 2012-5-10 20:24
我可能晓得为什么我的ssql出错的原因，老是提示参数不足，可能跟我查询中的参数有关吧，如图所示。

胡搞。
where子句先用窗体某个控件指定值即可。

简

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



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

ycxchen

简的钻研精神值得学习！

roych

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

我的代码是：

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

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

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

复制代码

简

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

On Error GoTo errit

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

简

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

这个应该简单了

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

简

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

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