怎样使用Outlook+Excel个性化群发邮件

发布网友 发布时间：2022-04-20 10:28

我来回答

共1个回答

热心网友 时间：2023-05-25 03:48

要使用宏的。
Sub fasong2() '发送邮件
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
Dim mypath$, fa$, r%, n%, h%, m%
'Sheets("Sheet2").Visible = True
h1 = Sheet1.[A65536].End(xlUp).Row
h2 = Sheet1.[E65536].End(xlUp).Row

If h1 >= 2 Then
If h2 = h1 Then Exit Sub

On Error Resume Next

n = h2 + 1

Namespace = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = Sheet0.Cells(105, 2).Value '发件人邮箱
fa = ""
fa = fa & Sheet1.Range("A" & n).Value & ";"

Email.To = fa '要发往的地址
Email.Subject = Sheet1.Range("B" & n).Value '标题
Email.Textbody = Sheet1.Range("C" & n).Value '正文

mypath = ThisWorkbook.Path & "\" '本工作簿所在文件夹
wvkey = Sheet1.Range("D" & n).Value

If Len(wvkey) > 3 Then
If Dir(mypath & wvkey) <> "" Then
Email.AddAttachment mypath & wvkey '& MyFile '附件
End If
End If
With Email.Configuration.Fields
.Item(Namespace & "smtpusessl") = 1
.Item(Namespace & "sensing") = 2
.Item(Namespace & "smtpserver") = Sheet0.Cells(102, 1).Value '发送邮件服务器
.Item(Namespace & "smtpserverport") = "465"
.Item(Namespace & "smtpauthenticate") = 1
.Item(Namespace & "sensername") = Sheet0.Cells(105, 2).Value '发件人QQ邮箱
.Item(Namespace & "sendpassword") = Sheet0.Cells(108, 3).Value '发件人QQ密码
.Update
End With
Email.send ''发送

If Err.Number = -2147220973 Then MsgBox "网络未连接！"

If Err.Number = -2147220975 Then MsgBox "错误，发送人地址或者密码不对！"

If Err.Number = -2147220977 Or Err.Number = -2147220980 Then MsgBox "收信人地址错误或者未填写！"

If Err.Number <> 0 And Err.Number <> -2147220977 And Err.Number <> -2147220980 And _
Err.Number <> -2147220975 And Err.Number <> -2147220973 Then MsgBox "其他错误!（超时、附件太大、邮箱已满） 未发送成功！"

If (Err.Number = 0) Then
Sheet1.Range("E" & n).Value = "已发送"
If h2 + 1 = h1 Then MsgBox "全部邮件发送完毕！"
Else
Sheet1.Range("E" & n).Value = "未被发送！"
If h2 + 1 = h1 Then MsgBox "全部邮件处理完毕！"
End If

Err.Clear
'Call jiange

Else
MsgBox "请核实数据，没有可发送的邮箱！"
End If
Application.ScreenUpdating = True '冻结屏幕，以防屏幕抖动
End Sub