群发邮件

MáοMáο゛趙

1. Sub 批量发送邮件()
   
2. 
   
3. '要能正确发送并需要对Microseft Outlook进行有效配置
   
4. 
   
5.     On Error Resume Next
   
6. 
   
7.     Dim rowCount, endRowNo
   
8. 
   
9.     '要正常运行下面这句,要将工具/引用中的Microseft Outlook *.0 Object Library(其中*为你Microseft Outlook的版本号)选上
   
10. 
    
11.     Dim objOutlook As New Outlook.Application
    
12. 
    
13.     Dim objMail As MailItem
    
14. 
    
15.     '取得当前工作表与Cells(1,1)相连的数据区行数
    
16. 
    
17.     endRowNo = Cells(1, 1).CurrentRegion.Rows.Count
    
18. 
    
19.     '创建objOutlook为Outlook应用程序对象
    
20. 
    
21.     Set objOutlook = New Outlook.Application
    
22. 
    
23.     '开始循环发送电子邮件
    
24. 
    
25.     For rowCount = 2 To endRowNo
    
26. 
    
27.         '创建objMail为一个邮件对象
    
28. 
    
29.         Set objMail = objOutlook.CreateItem(olMailItem)
    
30. 
    
31.         With objMail
    
32. 
    
33.             '设置收件人地址（从通讯录表的'E-mail地址'字段中获得）
    
34. 
    
35.             .To = Cells(rowCount, 1)
    
36.             
    
37.              '设置邮件抄送人
    
38.             
    
39.             .CC = Cells(rowCount, 2)
    
40. 
    
41.             '设置邮件主题
    
42. 
    
43.             .Subject = Cells(rowCount, 3)
    
44. 
    
45.             '设置邮件内容（从通讯录表的'内容'字段中获得）
    
46. 
    
47.             .Body = Cells(rowCount, 4)
    
48.             
    
49.             '设置重要性为高
    
50.             
    
51.              .Importance = 2
    
52. 
    
53.             '设置附件（从通讯录表的'附件'字段中获得）（第5列为docx表格附件）
    
54.             
    
55.             .Attachments.Add "E:\Users\admin\Desktop\测试邮件批量发送" & Cells(rowCount, 5) & ".docx"
    
56.             
    
57.             '设置附件（从通讯录表的'附件'字段中获得）（第6列为doc表格附件）
    
58. 
    
59.             .Attachments.Add "E:\Users\admin\Desktop\测试邮件批量发送" & Cells(rowCount, 6) & ".doc"
    
60.             
    
61.              '设置附件（从通讯录表的'附件'字段中获得）（第7列为xlsx表格附件）
    
62. 
    
63.             .Attachments.Add "E:\Users\admin\Desktop\测试邮件批量发送" & Cells(rowCount, 7) & ".xlsx"
    
64.             
    
65.              '设置附件（从通讯录表的'附件'字段中获得）（第8列为xls表格附件）
    
66. 
    
67.             .Attachments.Add "E:\Users\admin\Desktop\测试邮件批量发送" & Cells(rowCount, 8) & ".xls"
    
68.             '自动发送邮件
    
69. 
    
70.             .Send
    
71. 
    
72.         End With
    
73. 
    
74.         '销毁objMail对象
    
75. 
    
76.         Set objMail = Nothing
    
77. 
    
78.     Next
    
79. 
    
80. 
    
81.     '销毁objOutlook对象
    
82.     Set objOutlook = Nothing
    
83.     '所有电子邮件发送完成时提示
    
84.     MsgBox rowCount - 2 & "封邮件发送成功！"
    
85.     '
    
86.     If Application.Workbooks.Count = 1 Then
    
87.         Application.Quit
    
88.     Else
    
89.         Workbooks("自动发送邮件.xls").Close
    
90.     End If
    
91.     '
    
92. End Sub
    

复制代码

各位大神，这个代码Excel发完邮件，就自动关闭了，是什么原因？还有发送附件的那里的代码能给改成啥格式的都行么？因为如果格式不一样，每次还得再改，有点麻烦。

MáοMáο゛趙

哪位大神，帮我改下这个代码吧

简七

86-90行的代码删了

MáοMáο゛趙

简七 发表于 2023-5-15 19:56
86-90行的代码删了

那个文件格式怎么命名所有文件格式呀

闻启学

这个代码是可以运行的 ， 想发送邮件参考跟我来！  一步一步教你批量发送邮件 https://club.excelhome.net/thread-1158003-1-1.html (出处: ExcelHome技术论坛) 这个帖子

简七

MáοMáο゛趙 发表于 2023-5-16 09:14
那个文件格式怎么命名所有文件格式呀

.Attachments.Add这句循环下