如何将一个查询导出生成一个EXCEL文件，然后再激活outlook将这个文件发送出去？

panjianhui

我想将Access中的一个查询结果导出到Excel中，然后激活Outlook将这个文件发送出去？

rainless_9

Function ExportReport()
On Error GoTo ER_Err

    DoCmd.TransferSpreadsheet acExport, 8, "Q1080 RCTPO_Report", "C:\CORVU\DATA\Tgt19\Q1080 RCTPO_Report.xls", True, ""

ER_Exit:
    Exit Function

ER_Err:
    MsgBox Error$
    Resume ER_Exit

End Function


Function AutoReport()  '邮件发送设置
Dim objOL As Object
Dim itmNewMail As Object
'引用Microsoft Outlook 物件模型
Set objOL = CreateObject("Outlook.Application")
Set itmNewMail = objOL.CreateItem(olMailItem)

With itmNewMail
.Subject = "库存报告：QAD零件采购入库报告" '主题


                                          '本文
.Body = "    " & vbCrLf & _
        "这是一封自动邮件！" & vbCrLf & _
        "    " & vbCrLf & _
        "这封邮件包含本月1日开始至昨天为止的QAD零件采购入库记录。本邮件每个工作日更新。" & vbCrLf & _
         "    " & vbCrLf & _
         "记录包括：" & vbCrLf & _
        "1. 在7000地点的采购入库； " & vbCrLf & _
        "2. 在9000地点的采购入库，但并不是国内采购从7000地点转入的采购活动。" & vbCrLf & _
        "目前，程序设计上把9000地点的采购订单入库中，以人民币计价的认为是国内采购，并认为在7000中已经报告了采购入库情况，不再另作报告统计。" & vbCrLf & vbCrLf
        
        
.To = "rainless_9@126.com" '收件者

.Attachments.Add "C:\CORVU\DATA\Tgt19\Q1080 RCTPO_Report.xls", olByValue, 1, "Q1080 RCTPO_Report"   '附件

.Display

End With

On Error GoTo continue
SendEmail:
itmNewMail.Display
DoEvents
SendKeys "%s", Wait:=True
DoEvents
itmNewMail.Display


GoTo SendEmail '发送
continue:
On Error GoTo 0
Set objOL = Nothing
Set itmNewMail = Nothing

End Function

panjianhui

强！马上学习一下！

rainless_9

记得在access中药引用Outlook组件先

panjianhui

有个小问题，是不是如果OUTLOOK没有打开的情况下，邮件就不能立马发送啊！
如何才能保证几时outlook不打开的情况下也能立即发送邮件呢？

rainless_9

这段代码直接运行oulook发送邮件的，不需要打开outlook

canghua

强大。