EXCEL通过OUTLOOK2007自动发送邮件

1、EXCEL通过OUTLOOK2007自动发送邮件Suboutlook 发送()要预先对 outlook 进行配置，请先在 VBA 的工具/弓 I 用中引用 microsoftoutlook9.0objrctDimmyOlAppAsNewOutlook.ApplicationWithmyOlApp.CreateItem(olMailItem).Attachments.AddThisWorkbook.FullName附件.To=邮箱地址.Subject=请审批文件申请书主题.Body=文件申请书已填写完毕，请审批正文.CC=抄送.ReadReceiptRequested=True.Importan

2、ce=olImportanceHigh.Display.Send 发送EndWithSetmyOlApp=NothingEndSubPrivateSubCommandButton1_Click()ifCheckBox1.Value=TrueThenMsgBox(xuanzhong)EndIfApplication.DisplayAlerts=False在程序执行过程中使出现的警告框不显示Application.ScreenUpdating=False关闭屏幕刷新DimmyOlAppAsNewOutlook.ApplicationCalloutlook 发送Application.ScreenU

3、pdating=True打开屏幕刷新Application.DisplayAlerts=True在程序执行过程中出现的警告框EndSubPrivateSubCommandButton1_Click()DimobjOLAsObjectDimitmNewMailAsObject引用MicrosoftOutlook物件模型DimmytileAsStringDimyounameAsStringDimmybodyAsStringDimmysheetAsWorksheetSetmysheet=ThisWorkbook.Sheets(发送邮件界面”)DimFasongNameAsString发送人员名单Di

4、mmywordAsStringDimmychaosAsStringDimlastrowAsInteger定义最后一行DimiAsIntegerlastrow=mysheet.I65536.End(xlUp).RowFori=5TolastrowFasongName=mysheet.Cells(i,9)mychaos=mysheet.Cells(i,12)抄送人员名单SetobjOL=CreateObject(Outlook.Application)SetitmNewMail=objOL.CreateItem(olMailItem)mytile=mysheet.Cells(19,2)myword

5、=mysheet.Cells(10,2)&mysheet.Cells(i,10)&Chr(10)&_mysheet.Cells(11,2)&Chr(10)&mysheet.Cells(12,2)&mysheet.Cells(i,11)&_mysheet.Cells(13,2)&Chr(10)&_mysheet.Cells(14,2)WithitmNewMail.Subject=mysheet.Cells(8,2)主旨.Body=myword本文.To=FasongName收件者.CC=mychaos抄送邮件.CC=抄送邮件

6、.BCC=密件抄送IfmytileThen.Attachments.AddmytileEndIf.Display则如H窗.SendEndWithOnErrorGoTocontinueSendEmail:AppActivateitmNewMailDoEventsSendKeys%s,Wait:=TrueDoEventsAppActivateitmNewMailGoToSendEmail发送不成功誓不罢休continue:OnErrorGoTo0SetobjOL=NothingSetitmNewMail=NothingNexti参考下面的VBA代码SubSend_Email()DimiAsInte

7、gerDimMyOutlookAppAsOutlook.ApplicationDimMyFolderAsOutlook.MAPIFolderDimMyNewMailAsOutlook.MailItemDimMyAttachmentsAsOutlook.Attachments附件SetMyOutlookApp=NewOutlook.ApplicationSetMyFolder=MyOutlookApp.GetNamespace(MAPI).GetDefaultFolder(olFolderInbox).Folders(我的邮件文件夹)SetMyNewMail=MyOutlookApp.Creat

8、eItem(olMailItem)WithMyNewMail.To=YourFridentM目标邮件地址.Cc=标题.HTMLBody=Thisisred.AlternateRecipientAllowed=True此邮件可转发.AutoForwarded=True此邮件允许自动转发.DeleteAfterSubmit=False发送后保留副本发送之后移动到指定文件夹.SaveSentMessageFolder=MyOutlookApp.GetNamespace(MAPI).GetDefaultFolder(olFolderInbox).Folders(备份文件夹).ReadReceiptRequested=True要求收件人回执SaveSentMessageFolderEndWith附件SetMyAttachments=MyNewMail.