如何用vb发邮件
我想做一个简单的自动发邮件的工具,就是当我按下一个按钮后,然后什么也没弹就发送邮件到邮箱1234@yahoo.cn中,发件箱是12345@yahoo.cn密码是123 内容是变量‘a’和‘b’的值,如果不方便在问问里面回答或需要发附件的可以直接发到我的邮箱c457631461@vip.qq.com
请做成我要求的那样,不要随便去网上搜下发给我 谢谢
追问:我按上面的输入正确的邮箱地址和密码后运行发送后就提示这个,If Dir(SysParh & "\JMail.dll") = "" Then '如果没有jmail.dll,复制并且注册
这句什么意思,我更改后的代码是下面这样,你看看哪里还有错?Option Explicit
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Sub SendMail(Optional ByVal sSubject As String, Optional ByVal sBody As String, Optional ByVal sFileName As String)
Dim jmail As Object
With CreateObject("jmail.Message")
If sFileName <> "" Then .AddAttachment sFileName
.Charset = "gb2312"
.Silent = False
.Priority = 1 '
.From = "1234@yahoo.cn"
.MailServerUserName = "c1057002@163.com"
.MailServerPassWord = "pokemon"
.AddRecipient "c1057001@163.com"
.Subject = sSubject
.Body = sBody
.Send ("smtp.163.com") '自己查一下
End With
End Sub
Private Sub Command1_Click()
SendMail "a", "b", "" '最后是附件文件,你可以加入
End Sub
Private Sub Form_Load()
Dim arr() As Byte, SysParh As String
SysParh = Space(256)
GetSystemDirectory SysParh, 256
SysParh = Trim(SysParh)
SysParh = Left(SysParh, Len(SysParh) - 1)
If Dir(SysParh & "\JMail.dll") = "" Then '如果没有jmail.dll,复制并且注册
ReDim arr(1 To 318464)
arr = LoadResData(101, "CUSTOM")
Open SysParh & "\JMail.dll" For Binary As #1
Put #1, , arr
Close #1
Shell "regsvr32 /s " & SysParh & "\JMail.dll", vbHide
End If
End Sub
答案:'收邮件
'有些服务器不支持jmail收发邮件,但163信箱肯定可以,自己测试一下
Option Explicit
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongSub SendMail(Optional ByVal sSubject As String, Optional ByVal sBody As String, Optional ByVal sFileName As String)
Dim jmail As Object
With CreateObject("jmail.Message")
If sFileName <> "" Then .AddAttachment sFileName
.Charset = "gb2312"
.Silent = False
.Priority = 1 '
.From = "1234@yahoo.cn"
.MailServerUserName = "1234@yahoo.cn"
.MailServerPassWord = "123"
.AddRecipient "1234@yahoo.cn"
.Subject = sSubject
.Body = sBody
.Send ("smtp.yahoo.cn") '自己查一下
End With
End Sub
Private Sub Command1_Click()
SendMail "a", "b", "" '最后是附件文件,你可以加入
End Sub
Private Sub Form_Load()
Dim arr() As Byte, SysParh As String
SysParh = Space(256)
GetSystemDirectory SysParh, 256
SysParh = Trim(SysParh)
SysParh = Left(SysParh, Len(SysParh) - 1)
If Dir(SysParh & "\JMail.dll") = "" Then '如果没有jmail.dll,复制并且注册
ReDim arr(1 To 318464)
arr = LoadResData(101, "CUSTOM")
Open SysParh & "\JMail.dll" For Binary As #1
Put #1, , arr
Close #1
Shell "regsvr32 /s " & SysParh & "\JMail.dll", vbHide
End If
End Sub
我用的是jmail组件发邮件的,给你个过程代码:
Sub SendMail()
Dim jmail As Object
Set jmail = CreateObject("JMAIL.Message") ';建立发送邮件的对象
jmail.Silent = True ''一般不用改
jmail.Charset = "gb2312" ''信件的语言编码
jmail.ContentType = "text/html" ''信件的格式html或纯文本
jmail.From = "****@163.com" ''发信人邮箱
jmail.FromName = "****" ''发信人姓名
jmail.Subject = "" ''信件主题
jmail.AddRecipient "****" ''收信人地址
jmail.Body = "" ''信件正文
jmail.MailServerUserName = "****" ''服务器登陆用户名(您的邮件地址)
jmail.MailServerPassWord = "****" ''服务器登陆密码(您的邮件密码)
jmail.Send ("smtp.163.com") ''服务器地址
jmail.Close
Set jmail = Nothing
End Sub
不明白的再问
'用系统内置的CDO组建发送邮件
Dim NameS As String
Dim Email As Object
NameS = " http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = "12345@yahoo.cn" ' //你自己的油箱号码
Email.To = "1234@yahoo.cn" ' // 你自己的油箱号码(可以和上面相同)
Email.Subject = "" ' //相当于邮件里的标题
Email.Textbody = a & b '//相当于邮件里的内容
Email.Configuration.Fields.Item(NameS & "sendusing") = 2
Email.Configuration.Fields.Item(NameS & "smtpserver") = "smtp.yahoo.cn" '//邮件服务器(邮件服务器一定要对,要不然没用!)
Email.Configuration.Fields.Item(NameS & "smtpserverport") = 25 '//端口号
Email.Configuration.Fields.Item(NameS & "smtpauthenticate") = 1
Email.Configuration.Fields.Item(NameS & "sendusername") = "12345" '//油箱号码@前面的名字
Email.Configuration.Fields.Item(NameS & "sendpassword") = "123" '//你油箱的密码
Email.Configuration.Fields.Update
Email.Send
'我也是使用系统组件CDO发送的(请注意引用)
'为了方便你使用 我写的是发送邮件调用函数
Private Function SendEMail(ByVal mFrom As String, _
ByVal mTo As String, _
mTitle As String, _
mText As String, _
mSmtp As String, _
mUserName As String, mPassWord As String) As Boolean
On Error GoTo Fail
Dim Email As Object, NameS As String
NameS = " http://schemas.microsoft.com/cdo/configuration/"
Set Email = CreateObject("CDO.Message")
Email.From = mFrom
Email.To = mTo
Email.Subject = mTitle
Email.Textbody = mText
Email.Configuration.Fields.Item(NameS & "sendusing") = 2
Email.Configuration.Fields.Item(NameS & "smtpserver") = mSmtp
Email.Configuration.Fields.Item(NameS & "smtpserverport") = 25
Email.Configuration.Fields.Item(NameS & "smtpauthenticate") = 1
Email.Configuration.Fields.Item(NameS & "sendusername") = mUserName
Email.Configuration.Fields.Item(NameS & "sendpassword") = mPassWord
Email.Configuration.Fields.Update
Email.Send
SendEMail = True
Exit Function
Fail:
End Function
Private Sub command_Click()
If SendEMail("798897723@qq.com", "798897723@qq.com", _
"发信测试", "", "SMTP.QQ.COM","798897723", _
"1992826ABCabc") = True Then
MsgBox "发信测试成功", 64, ""
Else
MsgBox "发信测试失败", 16, ""
End If
End Sub
上一个:VB、DELPHI、C
下一个:学C语言需要有VB的基础吗?