[求助]群发邮件代码修改

zhaodx

请问在某个路径下的附件怎么加上去, 还有就是发送过程中, 提示信息无法去掉.请高手帮忙填加代码! x1hJ9lbi.rar (10.59 KB, 下载次数: 109)

2006-11-15 00:51 上传

点击文件名下载附件
[求助]群发邮件代码修改

Private Sub CommandButton1_Click()
Application.DisplayAlerts = False
  On Error Resume Next
  Dim rowCount, endRowNo
  Dim objOutlook As New Outlook.Application
  Dim objMail As MailItem
 
  endRowNo = Range("A65536").End(xlUp).Row
 
  Set objOutlook = New Outlook.Application
 
  For rowCount = 7 To endRowNo
  Set objMail = objOutlook.CreateItem(olMailItem)
  With objMail
  .To = Cells(rowCount, 4)
  .Subject = Cells(2, 3)
  .Body = Cells(3, 3)
  .Attachment.Add Cells(4, 3)
  .Send
  End With
 
  Set objMail = Nothing
  Next
  Set objOutlook = Nothing
  MsgBox endRowNo - 6 & " " & "mails sent successfully!"
  Application.DisplayAlerts = True
End Sub

[此贴子已经被作者于2006-11-15 0:52:40编辑过]

zhaodx

Hope sb. can help me!

zhaodx

我已经试验成功，就是有些缺憾，每发一个邮件，有警告信息提示，还有不知如何加附件，请帮忙完善！

swaywood

 .Attachment.Add Cells(4, 3)
就是加附件!

busan522

Attachment 应该修改为Attachments

busan522

还有Cells(4, 3)要写上附件的路径。

panpan0124

.Attachments.Add Cells(4, 3).Value

gilligan

1. Private Sub CommandButton1_Click()
   
2. Application.DisplayAlerts = False
   
3.   On Error Resume Next
   
4.   Dim rowCount, endRowNo
   
5.   Dim objOutlook As New Outlook.Application
   
6.   Dim objMail As MailItem
   
7.   
   
8.   endRowNo = Range("A65536").End(xlUp).Row
   
9. 
   
10.   Set objOutlook = New Outlook.Application
    
11.   
    
12.   For rowCount = 7 To endRowNo
    
13.   Set objMail = objOutlook.CreateItem(olMailItem)
    
14.   With objMail
    
15.   .To = Cells(rowCount, 4)
    
16.   .Subject = Cells(2, 3)
    
17.   .Body = Cells(3, 3)
    
18.   .Attachments.Add Cells(4, 3) '完整路径包括文件名.后缀，如F:\ExcelPratice\test.txt
    
19.   
    
20.   .Send
    
21.   End With
    
22.   
    
23.   Set objMail = Nothing
    
24.   Next
    
25.   Set objOutlook = Nothing
    
26.   'MsgBox endRowNo - 6 & " " & "mail(s) sent successfully!" '不需要提示就注释掉这一行
    
27.   Application.DisplayAlerts = True
    
28. End Sub
    

复制代码

赣州韵达

找不到工程或库 这是为什么

闻启学

赣州韵达 发表于 2020-2-16 23:07
找不到工程或库 这是为什么

这个代码要添加引用  的   

参考下这个帖子
跟我来！  一步一步教你批量发送邮件
http://club.excelhome.net/thread-1158003-1-1.html
(出处: ExcelHome技术论坛)