outlook群发带不同附件的邮件

天地有雪 · 发表于 2013-8-20 10:36

本帖最后由天地有雪于 2013-8-20 10:38 编辑

各位高人，因为工作需要的原因！我每天都要发送大量带附件的邮件，但自己不会做，请求各位高人帮忙教教我！谢谢！

附件中有名单和要发送的附件，希望可以用outlook群发，把对应的附件发送给对应的人员！

我之前在论坛上搜索过，可是不会用！如果可以，希望高手们能详细解答！万分感谢！
哦~忘了说，我是07版的outlook，应该没有影响的吧！

wdx223 · 发表于 2013-8-20 12:41

Sub sendemail()
Dim myOlApp As Object
Dim myitem As Object
Dim i As Integer, j As Integer
Dim strg As String
Dim atts As Object
Dim mycc As Object
Dim myfile As String
Set myOlApp = CreateObject("Outlook.Application")
With Sheets("Sheet1")
i = 2
Do While .Cells(i, 2) <> ""
Set myitem = myOlApp.CreateItem(0)
Set atts = myitem.Attachments
myitem.To = .Cells(i, 2) '收件人E-mail
myitem.Subject = .Cells(i, 3) '标题
myitem.Body = .Cells(i, 1) & "，你好！" & vbNewLine & vbNewLine & vbNewLine & .Cells(i, 4) '正文
myfile = Dir(ThisWorkbook.Path & "\*" & .Cells(i, 1) & "*.*")
Do Until myfile = ""
myitem.Attachments.Add ThisWorkbook.Path & "" & myfile, 1
myfile = Dir
Loop
myitem.display '预览，如果想直接发送，把.display改为.send
i = i + 1
strg = ""
Loop
End With
Set myitem = Nothing
End Sub

复制代码

天地有雪 · 发表于 2013-8-20 13:09

wdx223 发表于 2013-8-20 12:41

感谢高手帮忙！这个问题烦了我好久了！谢谢啦！
另外想问一下！这个代码需要注意些什么啊？比如说是不是附件要和这个名单放在同一个文件夹，发送的邮件才会带上附件啊？

wdx223 · 发表于 2013-8-20 13:30

天地有雪发表于 2013-8-20 13:09
感谢高手帮忙！这个问题烦了我好久了！谢谢啦！
另外想问一下！这个代码需要注意些什么啊？比如说是不是 ...

是的，带代码的文件必须和附件放在同一个文件夹，而且附件的文件名必须包括收件人的名字

天地有雪 · 发表于 2013-8-21 17:56

wdx223 发表于 2013-8-20 13:30
是的，带代码的文件必须和附件放在同一个文件夹，而且附件的文件名必须包括收件人的名字

高手，不好意思啦！现在我发现欠缺了一些，我想要每一封邮件都抄送给老板！这个代码需要怎么更改呢？麻烦你了！谢谢！

wdx223 · 发表于 2013-8-22 09:19

Sub sendemail()
Dim myOlApp As Object
Dim myitem As Object
Dim i As Integer, j As Integer
Dim strg As String
Dim atts As Object
Dim mycc As Object
Dim myfile As String
Set myOlApp = CreateObject("Outlook.Application")
With Sheets("Sheet1")
i = 2
Do While .Cells(i, 2) <> ""
Set myitem = myOlApp.CreateItem(0)
Set atts = myitem.Attachments
myitem.To = .Cells(i, 2) '收件人E-mail
myitem.cc = .Cells(i, 3) 'CC
myitem.Subject = .Cells(i, 4) '标题
myitem.Body = .Cells(i, 1) & "，你好！" & vbNewLine & vbNewLine & vbNewLine & .Cells(i, 5) '正文
myfile = Dir(ThisWorkbook.Path & "\*" & .Cells(i, 1) & "*.*")
Do Until myfile = ""
myitem.Attachments.Add ThisWorkbook.Path & "" & myfile, 1
myfile = Dir
Loop
myitem.display '预览，如果想直接发送，把.display改为.send
i = i + 1
strg = ""
Loop
End With
Set myitem = Nothing
End Sub

复制代码

1453156516156 · 发表于 2013-12-13 11:14

代码写在哪里？

天地有雪 · 发表于 2013-12-16 18:16

1453156516156 发表于 2013-12-13 11:14
代码写在哪里？

已经解决了！谢谢你的帮忙！

茜草山野猪 · 发表于 2015-1-21 20:31

楼主请问wdx223老师给的后面的代码，只能自动抄送而不能添加附件了，我对比了代码也没搞明白，你知道怎么办吗？谢谢

茜草山野猪 · 发表于 2015-1-21 20:42

已经解决了谢谢大神们

		自动登录	找回密码
密码			免费注册

[求助] outlook群发带不同附件的邮件

评分

评分