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

chajiangliang

打開文件時用到. ShellExecute Me.hwnd, "Open", App.Path & "\Results\Orders1.xls", "", "C:\", SW_SHOWNORMAL

esmile

很好,其实改为通用函数岂不更好?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_NORMALerrexit:

   oBook.Close False

   oExcel.Quit

   Set oBook = Nothing

   Set oExcel = Nothing

   Exit Suberrit:

   MsgBox "错误号为" & Err.Number & " 错误说明：" & Err.Description

   Resume errexitEnd 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

爱情插班生

整理:1.子窗体导出,筛选,2. 奇怪的lookup_筛选字符....

并提出问题: 如何不导出隐藏列!          swdq

[em01][em01][em01]

[此贴子已经被作者于2005-9-9 17:45:01编辑过]

hsn2914

当一个掉到海里的人求救的时候，他所需要的是一个救生圈，而不是学游泳的方法。获救以后想必他自己会去学会游泳，因为不是每次都会有人及时地丢给你一个救生圈。非常感谢海狸先生！

sea.er

抛砖引玉，都是好东东[em02]

GORYUNGBBS

好东西,不过我不大明白.以下命令就可以实现. 不过没比较速度和格式如何.

docmd.OutputTo acOutputForm,formname,acformatXls,filename,autostart

LucasLynn

以下是引用hsn2914在2005-9-9 18:08:00的发言：



当一个掉到海里的人求救的时候，他所需要的是一个救生圈，而不是学游泳的方法。

获救以后想必他自己会去学会游泳，因为不是每次都会有人及时地丢给你一个救生圈。

非常感谢海狸先生！

我小时候我爸带我去江里手把手地教我学游泳，学了三年没学会，第四年夏天我爸不耐烦了，把我一个人丢在江中央，折腾到水面上快没动静了才把我捞上来，歇了一会儿又把我丢下去了，结果不到一礼拜，我就一个人在水里狗刨了。

tmtony

以下是引用LucasLynn在2005-9-10 8:47:00的发言：





我小时候我爸带我去江里手把手地教我学游泳，学了三年没学会，第四年夏天我爸不耐烦了，把我一个人丢在江中央，折腾到水面上快没动静了才把我捞上来，歇了一会儿又把我丢下去了，结果不到一礼拜，我就一个人在水里狗刨了。

倒是个好方法  

zyz218

好贴就顶一下