[讨论] 如何把用户选择的记录导出

hunrybecky

[讨论] 如何把用户选择的记录导出一般而言，都是通过复制然后打开EXCEL粘贴即可。但是这个方法要打开其他对象如EXCEL等才能实现，而且操作比较麻烦，有一定局限性，如果直接使用DOCMD.OutputTo则不能把用户选择的记录进行输出，而只能对整个表等进行输出。为此提出这个讨论具有必要行。
我的想法是，既然DOCMD.OutputTo只能输出表，所以就可以把选择的记录保存到临时表中再导出就可以解决问题。但是再使用中我遇到了问题，希望高手们一起来讨论这个问题

With Me.subMC.Form '子表单subMC
    Dim intStartR As Integer '定义用户选择的开始记录号
    Dim intEndR As Integer '定义用户选择的结束记录号
    Dim intRows As Integer '定义用户选择的行数
    'Dim i As Integer
    'Dim strSQL As String
    If .SelHeight > 0 Then
        intStartR = .CurrentRecord
        intEndR = .SelTop + .SelHeight
        intRows = intEndR - intStartR '获取用户选择的记录,注意的是用户必须从上而下选择记录,而不能从下而上选择记录
        'strSQL = "SELECT * INTO tmpTemp FROM whMC2 WHERE MCNo='" & .MCNo & "' AND Item='" & .Item & "'"
        'If intEndR - intStartR >= 1 Then
        '    For i = (intStartR + 1) To intEndR
        '        strSql1 = "再把其他记录追加到表"
        '    Next i
        'End If
        Dim rst As ADODB.Recordset '定义当前记录集
        Set rst = .RecordsetClone
        Dim intFieldCount As Integer '定义并获取当前记录集的字段数量
        intFieldCount = rst.Fields.Count
        Dim arrGetR As Variant, x As Integer, y As Integer '定义记录集数组,上标和下标
        arrGetR = rst.GetRows(intRows, .Bookmark) '获取记录集的指定行数
        '=================================================================循环输出记录
        For x = 0 To intRows - 1 '
            For y = 0 To intFieldCount - 1
                Debug.Print arrGetR(y, x) & ";";
            Next y
        Debug.Print vbCrLf
        Next x
        '=================================================================循环输出记录
    End If
    'DoCmd.RunSQL strSQL
    'DoCmd.OutputTo acOutputTable, "tmpTemp", , , True
End With

问题就在于这里，如何把循环输出的记录写如一个带字段名称的表中？以前在一个台湾人写的ACCESS书写的一个财务管理方面的书中有介绍，可是现在忘记怎么操作了，希望高手指点

tmtony

刚才还没有测试出来,继续试, 这么快就发上来了

hunrybecky

是呀，一个下午和晚上都在搞这个。

hunrybecky

写到这里，已经可以正确判断用户选择的记录了。但是如何写到表中并导出呢？

andymark

用 DoCmd.TransferSpreadsheet　可以导出表可查询的

andymark

我通过查询来导出的,  因为导出的格式基本一样,所以主要设置好查询的字段就基本满足查询的数据的要求
Dim StrExcelName As String
         Dim StrFilename As String
         StrFilename = Me.TxtCcode & "总表.xls"
         StrExcelName = CurrentProject.Path & "\ExcelFile\" & StrFilename
         If Dir(StrExcelName) <> "" Then
            Kill StrExcelName
         End If
         DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "汇总报表", StrExcelName, True

andymark

汇总报表 为查询名

tmtony

他主要想法,是想用户随选随导, 没有固定的条件

andymark

能否做个简单的例子上来测试

t小宝

  用下面这种方式添加数据到电子表格，在不安装EXCEL的电脑上也行，而且速度快

    Dim dbs As New ADODB.Connection
   
    Dim rst As New ADODB.Recordset
   
    Dim sName As String
   
    sName = "c:\人员表.xls"
   
    ' 建立电子表格 （用一个空的数据源新建一个电子表格，这样表格只有字段名一行）
    CurrentDb.Execute "SELECT * INTO [Excel 8.0;DATABASE=" & sName & "].Sheet1 FROM (Select * From 人员表 Where false)"
   
    ' 连接电子表格
    dbs.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sName & ";Extended Properties=""Excel 8.0;"""
   
    ' 以记录集方式打开电子表格
    rst.Open "Select * from [Sheet1$]", dbs, adOpenForwardOnly, adLockOptimistic
   
    ' 然后在这里把数组中的数据循环添加到表格记录集中
    rst.AddNew
   
    rst!("姓名") = "张三"
   
    rst.Update