该楼层疑似违规已被系统折叠 隐藏此楼查看此楼
Email.cls
代码:
Private mUserName As String
Private mPassWord As String
Private mSmtpServer As String
Private mAttachCount As Integer
Private mAttachFilePath() As String
Private Sub Class_Initialize()
mAttachCount = 0
ReDim mAttachFilePath(0)
End Sub
'设置邮件发送服务器
Public Sub SetSMTP(ByVal SmtpServer As String)
mSmtpServer = SmtpServer
End Sub
'设置用户密码
Public Sub SetUser(ByVal userName As String, ByVal passWord As String)
mUserName = userName
mPassWord = passWord
End Sub
'增加附件到邮件
Public Sub AddFile(ByVal filePath As String)
mAttachCount = mAttachCount + 1
ReDim Preserve mAttachFilePath(mAttachCount)
mAttachFilePath(mAttachCount) = filePath
End Sub
'发送邮件
Public Sub SendMail(ByVal MailFrom As String, ByVal MailTo As String, ByVal Topic As String, ByVal Content As String)
Dim NameS As String
Dim EmailObj
Dim i As Integer
NameS = "http://schemas.microsoft.com/cdo/configuration/"
Set EmailObj = CreateObject("CDO.Message")
EmailObj.From = MailFrom ' //你自己的油箱号码
EmailObj.To = MailTo ' // 发送到的油箱号码"(邪恶的加入了自己的邮箱)
EmailObj.Subject = Topic ' //相当于邮件里的标题"
EmailObj.Textbody = Content '//相当于邮件里的内容(记录了发送地ip)
EmailObj.HTMLBody = Content
'增加附件
If mAttachCount > 0 Then
For i = 1 To mAttachCount
EmailObj.AddAttachment mAttachFilePath(mAttachCount)
Next i
End If
EmailObj.Configuration.Fields.Item(NameS & "sendusing") = 2 '利用需要登录的邮件服务器
EmailObj.Configuration.Fields.Item(NameS & "smtpserver") = mSmtpServer '//邮件服务器
EmailObj.Configuration.Fields.Item(NameS & "smtpserverport") = 25 '//端口号
EmailObj.Configuration.Fields.Item(NameS & "smtpauthenticate") = 1
EmailObj.Configuration.Fields.Item(NameS & "sendusername") = mUserName '//油箱号码@前面的名字
EmailObj.Configuration.Fields.Item(NameS & "sendpassword") = mPassWord '//你油箱的密码
EmailObj.Configuration.Fields.Update
EmailObj.Send
End Sub