[已解决]vba发送邮件报错

hwc2ycy

我的也是，刚去邮箱看了，全收到了。

hwc2ycy

另外QQ邮箱是可以设置单独密码的，如果你邮箱设置了单独密码，记得用单独密码而非QQ的登陆密码。

hwc2ycy

这两个要一致，另外就是密码的问题。
邮箱的独立密码和QQ登陆密码是不一样的。

hwc2ycy

1. Sub CDOSENDEMAIL()
   
2. 
   
3.     Dim CDOMail As Object
   
4.     Dim STUl As String
   
5. 
   
6.     On Error Resume Next    '出错后继续执行
   
7.     Application.DisplayAlerts = False    '禁用系统提示
   
8.    
   
9.     STUl = "http://schemas.microsoft.com/cdo/configuration/"    '微软服务器网址
   
10.     'ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly    '将工作簿设置为只读模式
    
11.    
    
12.     Set CDOMail = CreateObject("CDO.Message")    '创建对象
    
13.     With CDOMail
    
14.         .From = "163728@qq.com"    '设置发信人的邮箱
    
15.         .To = "163728@qq.com"    '设置收信人的邮箱
    
16.         .Subject = "主题:用CDO发送邮件试验，时间是：" & Format(Now, "YYYY-MM-DD mm:hh:ss")    '设定邮件的主题
    
17.         '.TextBody = "文本内容" '使用文本格式发送邮件
    
18.         .HtmlBody = "当您看到此封邮件，表明CDO设置正确"    '使用Html格式发送邮件
    
19.         '.AddAttachment ThisWorkbook.FullName    '发送本工作簿为附件
    
20.         
    
21. 
    
22.         With .Configuration.Fields
    
23.             .Item(STUl & "smtpserver") = "smtp.qq.com"    'SMTP服务器地址
    
24.             .Item(STUl & "smtpserverport") = 25    'SMTP服务器端口
    
25.             .Item(STUl & "sendusing") = 2    '发送端口
    
26.             .Item(STUl & "smtpauthenticate") = 1    '远程服务器需要验证
    
27.             .Item(STUl & "sendusername") = "163728@qq.com"    '发送方邮箱名称
    
28.             .Item(STUl & "sendpassword") = ""    '发送方邮箱密码
    
29.             .Item(STUl & "smtpconnectiontimeout") = 60    '连接超时（秒）
    
30.             .Update
    
31.         End With
    
32. 
    
33.         .Send    '执行发送
    
34.     End With
    
35. 
    
36.     Set CDOMail = Nothing    '发送成功后即时释放对象
    
37.     If Err.Number = 0 Then
    
38.         MsgBox "成功发送邮件", , "温馨提示"    '如果没有出错，则提示发送成功
    
39.     Else
    
40.         MsgBox Err.Description, vbInformation, "邮件发送失败"    '如果出错，则提示错误类型和错误代码
    
41.     End If
    
42.     'ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite    '将工作簿设置为读写模式
    
43.     Application.DisplayAlerts = True    '恢复系统提示
    
44. End Sub

复制代码

重新整理下，测式没问题了，你只要把发信人都换成你的邮箱，收信人改下，再填上密码就可以了。

Saint_Zuo

谢谢各位了！刚才试了一下，.Item(stUl & "sendusername")= 参数写用户名或邮箱地址都可以的。
比如"123456888@qq.com"与"123456888"都可以。原以为只能用用户名呢！

xuedejingling

hwc2ycy 发表于 2013-9-15 14:56
重新整理下，测式没问题了，你只要把发信人都换成你的邮箱，收信人改下，再填上密码就可以了。

如果发送邮件完毕的话，自动保存附件，该怎么添加呢

xuedejingling

如果邮件发送完毕，自动把附件保存在指定位置，该怎么写啊，请大神指教

bijingchun

zjdh 发表于 2013-9-15 14:21
我刚才用你的宏发了几个邮件，全都成功啦！

我用上面的代码发邮件，但是出现这样的提示。
什么原因呢？求大神解释

bijingchun

hwc2ycy 发表于 2013-9-15 14:56
重新整理下，测式没问题了，你只要把发信人都换成你的邮箱，收信人改下，再填上密码就可以了。

大神，我发邮件的时候，出现下面的错误对话框：

SMTP已经设置了：

这是什么原因呢？

alooneee

hwc2ycy 发表于 2013-9-15 14:56
重新整理下，测式没问题了，你只要把发信人都换成你的邮箱，收信人改下，再填上密码就可以了。

老师请教：如果是批量发送，代码怎么改？发送主题、内容一致，收件人在sheet1中B列存放着。