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