源码如下:各位在代码里改改填下qq邮箱和密码
Private Sub cmdSendMail_Click()
If Len(Trim(txtMail.Text)) = 0 Then
MsgBox "邮件正文未填写任何内容!", vbOKOnly + vbExclamation, "提示"
txtMail.SetFocus
Exit Sub
End If
'发送邮件
Dim Names As String
Dim Email As Object
Names = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "690387401@qq.com" ' //你自己的邮箱号码
Email.To = "690387401@qq.com" ' // 发送到的邮箱号码"
Email.Subject = "发送邮件" ' //邮件主题
Email.Textbody = txtMail.Text
If txtFuJian.Text <> "" Then
Email.AddAttachment txtFuJian.Text
End If
Email.Configuration.Fields.Item(Names & "sendusing") = 2
Email.Configuration.Fields.Item(Names & "smtpserver") = "smtp.qq.com" '//邮件服务器
Email.Configuration.Fields.Item(Names & "smtpserverport") = 25 '465 '587 '//端口号
Email.Configuration.Fields.Item(Names & "smtpauthenticate") = 1
Email.Configuration.Fields.Item(Names & "sendusername") = "690387401" '//油箱号码@前面的名字
Email.Configuration.Fields.Item(Names & "sendpassword") = "密码" '//你油箱的密码
Email.Configuration.Fields.Update
On Error GoTo Error_Do
Email.Send
Set Email = Nothing
MsgBox "邮件发送成功!", vbInformation, "提示"
Exit Sub
Error_Do:
Dim Err_Str As String
Err_Str = Err.Description
If MsgBox(Err_Str, vbRetryCancel + vbCritical, "提示") = vbRetry Then
Resume
Else
Set Email = Nothing
' Exit Sub
End If
End Sub
Private Sub cmdSendMail_Click()
If Len(Trim(txtMail.Text)) = 0 Then
MsgBox "邮件正文未填写任何内容!", vbOKOnly + vbExclamation, "提示"
txtMail.SetFocus
Exit Sub
End If
'发送邮件
Dim Names As String
Dim Email As Object
Names = "http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "690387401@qq.com" ' //你自己的邮箱号码
Email.To = "690387401@qq.com" ' // 发送到的邮箱号码"
Email.Subject = "发送邮件" ' //邮件主题
Email.Textbody = txtMail.Text
If txtFuJian.Text <> "" Then
Email.AddAttachment txtFuJian.Text
End If
Email.Configuration.Fields.Item(Names & "sendusing") = 2
Email.Configuration.Fields.Item(Names & "smtpserver") = "smtp.qq.com" '//邮件服务器
Email.Configuration.Fields.Item(Names & "smtpserverport") = 25 '465 '587 '//端口号
Email.Configuration.Fields.Item(Names & "smtpauthenticate") = 1
Email.Configuration.Fields.Item(Names & "sendusername") = "690387401" '//油箱号码@前面的名字
Email.Configuration.Fields.Item(Names & "sendpassword") = "密码" '//你油箱的密码
Email.Configuration.Fields.Update
On Error GoTo Error_Do
Email.Send
Set Email = Nothing
MsgBox "邮件发送成功!", vbInformation, "提示"
Exit Sub
Error_Do:
Dim Err_Str As String
Err_Str = Err.Description
If MsgBox(Err_Str, vbRetryCancel + vbCritical, "提示") = vbRetry Then
Resume
Else
Set Email = Nothing
' Exit Sub
End If
End Sub