声明：在“看见星光”的原代码基础上修改成个人定制版，感谢“看见星光”同志！
=================================
Sub 发邮件()
Dim CDOMail As Object
Dim strPath As String
Dim appendix As String
Dim aData As Variant
Dim i As Long
Dim strURL As String
Dim strFromMail As String
Dim strFromName As String
Dim strPassWord As String
strFromMail = "发件人邮箱"
strFromName = "发件人名称"
strPassWord = "发件人授权码"
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
strPath = newname'--------附件路径
On Error Resume Next
Set CDOMail = CreateObject("CDO.Message") '--------创建CDO对象
CDOMail.From = "发件人邮箱" '--------发信人的邮箱
CDOMail.To = "收件人邮箱" '--------收信人的邮箱
CDOMail.Subject = "我是主题" '--------邮件的主题
' CDOMail.HtmlBody = aData(i, 3) '--------邮件的内容（Html格式)
CDOMail.TextBody = "我是内容" '--------邮件的内容（文本格式)
CDOMail.AddAttachment strPath '--------邮件的附件
strURL = "http://schemas.microsoft.com/cdo/configuration/" '--------微软服务器网址
With CDOMail.Configuration.Fields
.Item(strURL & "smtpserver") = "smtp.qq.com" '--------SMTP服务器地址
.Item(strURL & "smtpserverport") = 25 '--------SMTP服务器端口
.Item(strURL & "sendusing") = 2 '--------发送端口
.Item(strURL & "smtpauthenticate") = 1 '--------远程服务器验证
.Item(strURL & "sendusername") = strFromName '--------发送方邮箱名称
.Item(strURL & "sendpassword") = strPassWord '--------发送方smtp密码
.Item(strURL & "smtpconnectiontimeout") = 60 '--------设置连接超时（秒）
.Update
End With
' CDOMail.AddAttachment ThisWorkbook.Path & "\" & strArray(i)
' appendix = "a.xlsx"
' CDOMail.AddAttachment newname
CDOMail.Send '--------发送
If Err.Number = 0 Then
MsgBox "邮件发送成功！"
Else
MsgBox "邮件发送失败！"
End If
Set CDOMail = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
,
