[分享]导出数据表型子窗体内容到Excel

huanghai

我也来加一帖，基础跟楼主的愿意差点不多，不家一种方法更简单，就是使用代码全选子窗体记录，然后复制，打开EXCEL粘贴即可，这样不要判断哪些字段显示了，哪些字段隐身了。我的代码如下。Function myOutputToExcel(Rst As Object)    If (Rst.EOF Or Rst.BOF) And Rst.RecordCount = 0 Then

        MsgBox "没有可导出的数据！", vbQuestion, gAppTitle

        Exit Function

    End If    'Dim xlsApp As Excel.Application

    Dim xlsApp As Object    Set xlsApp = CreateObject("Excel.Application")

    xlsApp.Workbooks.Add

    xlsApp.Visible = True    Dim C As Integer    With xlsApp.Workbooks(1).Worksheets(1)

        For C = 0 To Rst.Fields.Count - 1

            .Cells(1, C + 1) = Rst.Fields(C).Name

        Next

        Rst.MoveFirst

        .Cells(2, 1).CopyFromRecordset Rst

        .Cells.Select

        xlsApp.ActiveWindow.Selection.Font.Size = 9

        .Cells.EntireColumn.AutoFit

        .Cells(1, 1).Select    End WithEnd Function

午夜兰花

到底谁的方法最好啊？？？

wxf16

good

wxf16

好！

wxf16

[em01]

congee

很精彩的描述

LucasLynn

导出窗体Recordset为任意Access支持格式的数据文件

以下代码将DAO的RecordSet（包括Access窗体的Recordset）中的当前数据导出为任何Access支持的导出格式。无论你这个Recordset是从窗体的，还是代码创建的，是筛选后结果，还是链接了字段的主窗体，本程序均能正确导出结果，格式包括任何Access支持的导出格式。

'调用范例

Private Sub Botton_Click()

    Call Output_Recordset(Me.Recordset)

End Sub

<DIV class=quote>

'公共模块

Option Compare Database

Option Explicit

Public Sub Output_Recordset(ByRef frmRs As DAO.Recordset)

    Dim frmField As DAO.Field

    Dim daoDbs As DAO.Database

    Dim daoRs As DAO.Recordset



    Dim strSQL As String

    Dim strFields As String

   

    Set daoDbs = Application.CurrentDb

    Set daoRs = frmRs.Clone

   

    strSQL = "CREATE TABLE USysDAORecordsetOutport"

    strFields = "("

   

    For Each frmField In daoRs.Fields

        strFields = strFields & frmField.Name & " "

        Select Case frmField.Type

            Case dbBigInt:

                strFields = strFields & "Currency"

            Case dbBinary:

                strFields = strFields & "Binary"

            Case dbBoolean:

                strFields = strFields & "Bit"

            Case dbByte:

                strFields = strFields & "TinyInt"

            Case dbChar:

                strFields = strFields & "Char"

            Case dbCurrency:

                strFields = strFields & "Money"

            Case dbDate:

                strFields = strFields & "DateTime"

            Case dbDecimal:

                strFields = strFields & "Decimal"

            Case dbDouble:

                strFields = strFields & "Double"

            Case dbFloat:

                strFields = strFields & "Float"

            Case dbGUID:

                strFields = strFields & "Guid"

            Case dbInteger:

                strFields = strFields & "Integer"

            Case dbLong:

                strFields = strFields & "Long"

            Case dbLongBinary:

                strFields = strFields & "LongBinary"

            Case dbMemo :

                strFields = strFields & "Memo"

            Case dbNumeric:

                strFields = strFields & "Numeric"

            Case dbSingle:

                strFields = strFields & "Single"

            Case dbText:

                strFields = strFields & "Text(" & frmField.Size & ")"

            Case dbTime:

                strFields = strFields & "Time"

            Case dbTimeStamp:

                strFields = strFields & "DateTime"

            Case dbVarBinary:

                strFields = strFields & "VarBinary"

        End Select

        

        strFields = strFields & ","

    Next frmField

    strFields = Left(strFields, Len(strFields) - 1) & ")"

   

    On Error Resume Next

        daoDbs.Execute "DROP TABLE USysDAORecordsetOutport"

    On Error GoTo 0

    daoDbs.Execute strSQL & strFields

   

    daoRs.MoveFirst

    Do Until daoRs.EOF

        strSQL = "INSERT INTO USysDAORecordsetOutport("

        strFields = " Values("

        For Each frmField In daoRs.Fields

            If Not IsNull(frmField.Value) And Not IsEmpty(frmField.Value) Then

                strSQL = strSQL & frmField.Name & ","

                If frmField.Type = dbText Then

                    strFields = strFields & "'" & frmField.Value & "',"

                Else

                    strFields = strFields & frmField.Value & ","

                End If

            End If

        Next frmField

        strSQL = Left(strSQL, Len(strSQL) - 1) & ")"

        strFields = Left(strFields, Len(strFields) - 1) & ")"



        daoDbs.Execute strSQL & strFields

        daoRs.MoveNext

    Loop

   

    DoCmd.OutputTo acOutputTable, "USysDAORecordsetOutport"

   

    daoDbs.Execute "DR

zerosailing

向无私的海里先生致敬！

zerosailing

还有Mr.LucasLynn和Mr. huanghai!!

cdwlove

有没有实例看看!!!