outlook发送邮件

cr5260

求大神帮助，需要定时发送邮件，发送一个群组，抄送六位。并插入图片。

QCW911

1. sub Send_em()
   
2. 
   
3. Application.ScreenUpdating = False
   
4.     Dim outapp As Object
   
5.     Dim outmail As Object
   
6.     Dim body As String
   
7.     Dim fname As String
   
8. 
   
9.     Set outapp = CreateObject("Outlook.Application")
   
10.     Set outmail = outapp.CreateItem(0)
    
11. 
    
12.     fname = "C:\mywb.xls"               '这里设置你要附的文件
    
13.     body = "Please see attached."     '这里设置你的邮件内容
    
14.    
    
15.     On Error Resume Next
    
16.     With outmail
    
17.         .To = "name@yahoo.com; name1@yahoo.com"                 '收件人
    
18.         .CC = "name3@hotmail.com; name4@gmail.com"               '抄送人
    
19.         .BCC = "name5@tom.com; name6@qq.com"                     '密送人
    
20.         .Subject = "Hello!"                     '这里是你的主题
    
21.         .body = body
    
22.         .Attachments.Add fname
    
23.         .Display
    
24.     End With
    
25.     On Error GoTo 0
    
26.    
    
27.     Set outmail = Nothing
    
28.     Set outapp = Nothing
    
29. 
    
30. Application.ScreenUpdating = True
    
31. End Sub

复制代码

参考
q57726980