VBA代码、批量群发邮箱方法（2）

实现功能：批量群发邮箱

感觉这个比前面分享的那个方法发送邮箱要快点。

需要Excel模板订制请私聊

下面是代码分享

前期准备设置

前面都设置好了，就把下面代码写入进去

Sub cdosendmail()

Dim cdomail As Object

Dim strpath As String

Dim adata As Variant

Dim i As Long

Dim strurl As String

Dim strfrommail As String

Dim strpassword As String

strfrommail = Range(“b2”).Value

strfromname = Range(“b3”).Value

If strfrommail = “” Or strfromname = “” Then

MsgBox “未输入邮箱地址或名称”

Exit Sub

End If

strpassword = Range(“b4”).Value

If strpassword = “” Then

MsgBox “未输入smtp服务密码”

Exit Sub

End If

With Application

.ScreenUpdating = False

.DisplayAlerts = False

End With

Sheets(“数据”).Select

adata = Range(“a1:c” & Cells(Rows.Count, 1).End(xlUp).Row)

‘——数据装入数组aData

strpath = ThisWorkbook.Path & “暑假快乐.jpg”

‘——附件存放的路径+名称

‘On Error Resume Next

For i = 2 To UBound(adata)

Set cdomail = CreateObject(“cdo.message”)

‘——创建CDO对象

cdomail.from = strfrommail

‘——发信人的邮箱

cdomail.to = adata(i, 1)

‘——收信人的邮箱

cdomail.Subject = adata(i, 2)

‘——邮件的主题

cdomail.htmlbody = adata(i, 3)

‘——邮件的内容（Html格式）

cdomail.textbody = adata(i, 3)

‘——邮件的内容（文本格式）

cdomail.addattachment strpath

‘——邮件的附件

strurl = “http://schemas.microsoft.com/cdo/configuration/”

‘——微软服务器 址

With cdomail.configuration.Fields

.Item(strurl & “smtpserver”) = “smtp.qq.com”

‘——SMTP服务器地址

.Item(sturl & “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.send

‘——-发送

If Err.Number = 0 Then

adata(i, 3) = “发送成功”

Else

adata(i, 3) = “发送失败”

End If

Next

Range(“d1”).Resize(UBound(adata), 1) = Application.Index(adata, , 3)

Range(“d1”) = “发送状态”

Set cdomail = Nothing

With Application

.ScreenUpdating = True

.DisplayAlerts = True

End With

MsgBox “您好，发送任务完成”

End Sub

‘如果要使用163邮箱发送邮件。修改发件人的邮箱地址、名称和对应的smtp服务密码

‘将 .Item(strURL & “smtpserver”)=”smtp.qq.com” 改为 .Item(strURL & “smtpserver”)=”smtp.163.com”

‘如果将一封邮件发送多人，不同收件人之间使用半角分 间隔即可。

‘例：”42@qq.com;43@qq.com”