谢谢老头子.
参照了你的"【Access小品】传递子窗体中选中记录",但因为是利用生成表导出 到Excel因此重点在窗体的RecordSetClone属性的使用.
为了后来者,特将之也分享一下:
Private Sub Command导出_Click()
Dim theTempData As Variant, fd As FileDialog, thePath As String, theTableName As String
Dim ctls As Fields, ctl As Field, rst As Recordset, rst2 As Recordset
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.Title = "导出至 .xls类型"
.AllowMultiSelect = False
.ButtonName = "确定(&O)"
End With
theAddTextBox "请选择一个 Excel格式(.xls)文件，或单击“取消”按钮以退出！"
If fd.Show = -1 Then
thePath = fd.SelectedItems(1)
Set fd = Nothing
Hourglass "正在导出,请稍候", True
theTableName = theOptions("公司名称") & "猪群资料『部分』"
'生成一个基于子窗体格式的空表
DoCmd.RunSQL "CREATE TABLE " & theTableName & " (耳号 TEXT, 性别 TEXT,种类 TEXT,品种 TEXT,状态 TEXT,饲养员 TEXT,所在猪舍 TEXT)"
'打开这个空表
Set rst = CurrentDb.OpenRecordset(theTableName, dbOpenDynaset)
'rst2 为欲导出的窗体的记录源
Set rst2 = Me.Child猪群档案查询子窗体.Form.RecordsetClone
rst2.MoveFirst
Set ctls = rst.Fields
Do Until rst2.EOF
rst.AddNew
For Each ctl In ctls
ctl.Value = rst2.Fields(ctl.Name).Value
Next ctl
rst.Update
rst2.MoveNext
DoEvents
Loop
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, theTableName, thePath & IIf(Right(thePath, 3) = "xls", "", ".xls")
rst.Close
Set rst = Nothing
DoCmd.DeleteObject acTable, theTableName
Hourglass , False
Set rst2 = Nothing
theAddTextBox
End If
End Sub
注:theOptions("公司名称") 函数是用来读出公司名称的.可以自己替换
再次鸣谢老头子
