CDO.MESSAGE不发送邮件。没有错误,但未收到Range("B2")
中包含的电子邮件地址的邮件
我厌倦了尝试新方法。尝试了很多电子邮件ID,但没有成功。
Image attached for more clarity
Private Sub CommandButton1_Click()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "excel@vba.in.net"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.xyz.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
strbody = "<H3>Topic Here:</H3>" & _
"Body here<BR>"
'Paste selected range for formatted text
Dim cRange As Range
Set cRange = Worksheets("Sheet1").Range("A8:T20").SpecialCells(xlCellTypeVisible)
cRange.Select
cRange.Copy
cRange.PasteSpecial '???
'Application.ScreenUpdating = False
With iMsg
Set .Configuration = iConf
.To = Sheets("sheet1").Range("c4")
.CC = ""
.BCC = ""
.From = """VBA Macro"" <excel@vba.in.net>"
.Subject = ThisWorkbook.Name
.HTMLBody = strbody
' .send
End With
MsgBox ("Email has been sent successfully.")
End Sub