Office中国论坛/Access中国论坛

标题: [求助]怎样将子窗体查询到的内容作为附件发送电邮？以前牧人做了个OUTPUT Recordse [打印本页]

作者: secowu 时间: 2005-11-4 21:46
标题: [求助]怎样将子窗体查询到的内容作为附件发送电邮？以前牧人做了个OUTPUT Recordse
[求助]怎样将子窗体查询到的内容作为附件发送电邮？

以前牧人做了个OUTPUT Recordset导出很好用

能不能改下，加个参数X

X=1,则导出当前子窗体内容数据

X=2,则电邮当前子窗体内容数据（以附件方式，XLS格式）

作者: secowu 时间: 2005-11-4 21:59
举手之劳，功德无量

作者: secowu 时间: 2005-11-5 00:44
呵呵，修改大师牧人的作品，调试成功，大师看看，还有什么可改进的。

Option Compare Database

Option Explicit

Public Sub DealSubForm(frmMainForm As Form, frmSubFormName As String, a As String)

'*****************************************************

'使用示例：DealSubForm Me, Me.订单子窗体.Name,1

'2005-11-03 修改来自牧人(LucasLynn)的大作

'最后面的参数a，如果为1,则将当前查询到的数据以附件XLS格式进行发送电子邮件

'最后面的参数a，如果为2,则将当前查询到的数据以XLS格式导出并自动启动以便下一步处理

'******************************************************

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("订单明细查询")

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

If a = 1 Then

DoCmd.SendObject acSendQuery, "订单明细查询", acFormatXLS, , "", "", Date & "查询订单明细", "附件是" & Date & "查询订单明细情况，请查收", True, ""

DoCmd.DeleteObject acQuery, "订单明细查询"

Else: a = 2

DoCmd.OutputTo acOutputQuery, "订单明细查询", acFormatXLS, Date & "止订单明细查询.XLS", True

DoCmd.DeleteObject acQuery, "订单明细查询"

End If

DoCmd.DeleteObject acQuery, "订单明细查询"

Rs.Close

Set Rs = Nothing

Exit Sub

Outputerr:

Rs.Close

Set Rs = Nothing

If IsNull(DLookup("[Name]", "MSysObjects", "[Name] = '订单明细查询'")) = False Then

      DoCmd.DeleteObject acQuery, "订单明细查询"

End If

MsgBox Err.Description

End Sub

特别感谢牧人大师的源码才有这个功能的增加

[此贴子已经被作者于2005-11-4 19:17:34编辑过]

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)