当前位置：首页 → 问答吧 → OUTLOOK发送附件【未解决】

OUTLOOK发送附件【未解决】

时间：2009-03-05

来源：互联网

请教各位大侠，我想用outlook vba自动成批发送邮件，并添加附件，写了一个程序，这样我就可以发送附件了，但是问题是：
1、每次只能发送相同内容
2、如果附件不存在的话就会发生错误
我想要做到的是，1）可以运行宏的时候，可以将不同文件发送给不同的人，大概40个。2）如果某个附件不存在，则不发送这个人，其他的人还继续发送，或者在内容中写上"今天没有报告"。

每天都要发送40多个报告，太痛苦了，谢谢各位大侠了，小弟感激不尽！！
Sub SendMail()
Dim ItemUsageEmail As Outlook.MailItem
Set ItemUsageEmail = Application.CreateItem(olMailItem)
With ItemUsageEmail
.To = "[email protected]"
.Subject = "Report"
.Body = "This is a example"
.Attachments.Add "d:\bbb\2.docx"
.Display
End With
End Sub

[ 本帖最后由 thierryco 于 2009-3-5 15:58 编辑 ]

作者: thierryco 发布时间: 2009-03-05

哇，才这几分钟，就有这么多点击率了，多些大家的支持，相信我的问题一定能解决了~~

作者: thierryco 发布时间: 2009-03-05

第一个问题我想了下，用笨办法，复制40个这样的语句，把DIM的文件名更改下就可以了，最关键的就是判断是否有附件，然后自动选择是否发送

作者: thierryco 发布时间: 2009-03-05

请参考以下帖子.

http://club.excelhome.net/thread-400669-1-1.html

作者: aaaaabbbbb 发布时间: 2009-03-05

引用:

原帖由 aaaaabbbbb 于 2009-3-5 20:21 发表
请参考以下帖子.

http://club.excelhome.net/thread-400669-1-1.html

上面的代码我就是参考以上帖子得来的，关键我的问题没有得到解决。

作者: thierryco 发布时间: 2009-03-06

这个帖子里的代码可比你的要复杂多了,你的是最简单的发邮件的代码 . EXCEL里判断一下是否有附件的路径,如是空,则跳过,不给前面的地址发送.

作者: aaaaabbbbb 发布时间: 2009-03-06

楼上说的那个帖子的程序我运行不正常啊

作者: thierryco 发布时间: 2009-03-08

有什么问题?

作者: aaaaabbbbb 发布时间: 2009-03-10

Sub SendMail()

MMyNames = Array("张三@163.com", "李四@tom.com", "王五@hotmail.com") '收件人地址
MyDocuments = Array("张三.doc", "李四.doc", "王五.doc") '附件文件名,注意与收件人的一一对应关系

For DCount = 0 To UBound(Mynames) '设定循环次数，即收件人数。

MyFile = Dir("d:\bbb\" & MyDocuments(DCount)) '尝试从硬盘提取附件，逐个检测附件是否存在。

If Len(MyFile) > 0 Then '如果附件存在就进入发邮件程序。否则忽略。

   Call Sendthis(MyNames(Dcount), MyDocuments(Dcount))


End If

Next Dcount

End Sub

Sub Sendthis(ByVal MyName, ByVal MyDocument As String)
Dim ItemUsageEmail As Outlook.MailItem
Set ItemUsageEmail = Application.CreateItem(olMailItem)
With ItemUsageEmail
      .To = MyName  '提取相应的收件人，发送邮件。
      .Subject = "Report"
      .Body = "This is a example"
      .Attachments.Add "d:\ddd\" & MyDocument
      '.Display
      .Send
      End With
ItemUsageEmail = Nothing
End Sub

[ 本帖最后由 roof 于 2009-3-14 13:50 编辑 ]

作者: roof 发布时间: 2009-03-12

引用:

原帖由 roof 于 2009-3-12 11:44 发表

试试这个吧。我没有outlook,不能测试。

Sub SendMail()
Dim ItemUsageEmail As Outlook.MailItem
Set ItemUsageEmail = Application.CreateItem(olMailItem)

MyNames = Array("张三@163.com", "李四@tom ...

谢谢帮助，已经非常感激了，已经很接近我的想法了，不过出现两个文件以上附件都有的时候，就会出现错误；

例如，张三.doc和李四.doc两个文件都有，发送就显示错误，显示出来只能发送一个，并且，将张三.doc发送给李四@tom了并非，张三@163.com。如果只有其中一个文件，则一点问题都没有。

作者: thierryco 发布时间: 2009-03-14

显示编译错误，找不到工程或库，黄色提醒在olMailltem上

      Do While .Cells(i, 2) <> ""
         Set myitem = myOlApp.CreateItem(olMailItem)
         'retVal = ThisDrawing
         myitem.To = .Cells(i, 3)             '收件人E-mail

作者: thierryco 发布时间: 2009-03-14

我编辑了一下前贴，再试试吧。

作者: roof 发布时间: 2009-03-14

有意思的问题，学习一下。

作者: xzqzgr 发布时间: 2009-03-22

学习了，谢谢。

作者: xzqzgr 发布时间: 2011-08-03