用Outlook群发带不等量附件的邮件

VBA万岁

VBA万岁 发表于 2015-10-16 17:30
若第三个收件人“liweifang”（老总？）需收到所有附件，则如下：

若要求第三个收件人“liweifang”（部门主管？）只需收到上一行加本行两个附件，则如下：

1. Sub displayemail2()
   
2.     Dim myOlApp As Object
   
3.     Dim myitem As Object
   
4.     Dim i As Integer, j As Integer
   
5.     Dim strg As String
   
6.     Dim atts As Object
   
7.     Dim mycc As Object
   
8.     Dim myfile As String
   
9.     Set myOlApp = CreateObject("Outlook.Application")
   
10.    
    
11.     With Sheets("发送名单")
    
12.         i = 2
    
13.         Do While .Cells(i, 2) <> ""
    
14.             Set myitem = myOlApp.CreateItem(0)
    
15.            Set atts = myitem.attachments
    
16.             myitem.To = .Cells(i, 3)                                                    '收件人E-mail
    
17.             myitem.cc = .Cells(i, 4)                                                    'Cc
    
18.             myitem.Subject = .Cells(i, 5)                                               '标题
    
19.             myitem.Body = "Dear：" & vbNewLine & "#REF!单元格数据为空！"                '正文
    
20.             myfile = Dir(ThisWorkbook.Path & "\*" & .Cells(i, 1) & "*.*")
    
21.             'Do Until myfile = ""
    
22.                 'myitem.attachments.Add ThisWorkbook.Path & "" & myfile, 1              '上传附件
    
23.                 'myfile = Dir
    
24.                 If .Cells(i, 7) <> "" Then
    
25.                     myitem.attachments.Add ThisWorkbook.Path & "" & Dir(ThisWorkbook.Path & "\*" & .Cells(i - 1, 1) & "*.*"), 1
    
26.                     myitem.attachments.Add ThisWorkbook.Path & "" & Dir(ThisWorkbook.Path & "\*" & .Cells(i, 1) & "*.*"), 1
    
27.                     myfile = Dir
    
28.                 Else
    
29.                 myitem.attachments.Add ThisWorkbook.Path & "" & myfile, 1              '上传附件
    
30.                 myfile = Dir
    
31.                 End If
    
32.             'Loop
    
33.             myitem.display                                                                 '预览，如果想直接发送，把.display改为.send
    
34.             i = i + 1
    
35.             strg = ""
    
36.         Loop
    
37.     End With
    
38.     Set myitem = Nothing
    
39. End Sub

复制代码

王点点

闻启学 发表于 2014-7-19 19:14
无 可能的  啊 楼上

你好，为什么正文链接不上去呢？