IVY DOM


 

人生就像一副复杂拼图
每个人总有属於自己的记忆碎片
优质美国空间-老薛主机|IVY DOM|Flowline|

联系我

RSS




十月 02, 2011

[开源]VB 发送邮件

Private Declare Function GetOpenFileName Lib “comdlg32.dll” Alias “GetOpenFileNameA” (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Dim MailPassWord, MailUserName As String
Dim SendError As Boolean

Public Sub SendMail(Optional ByVal sSubject As String, _
Optional ByVal sBody As String, _
Optional ByVal sFileName As String, Optional ByVal MailTo As String)

On Error GoTo ToExit ‘打开错误陷阱
‘————————————————

Dim Jmail
Dim ErrorTimes As Integer
ErrorTimes = 0
Set Jmail = CreateObject(“jmail.Message”)
If sFileName <> “” Then Jmail.AddAttachment sFileName             ‘附件

Jmail.Charset = “gb2312″
Jmail.Silent = False
Jmail.Priority = 3  ‘邮件状态,1-5 1为最高
Jmail.MailServerUserName = Txt_QQNum.Text         ‘发件人Email帐号,自己改
Jmail.MailServerPassWord = Txt_QQPwd.Text        ‘发件人Email密码,自己改

Jmail.FromName = Txt_QQNum.Text          ‘发信人姓名,自己改
Jmail.From = Txt_QQNum.Text & “@qq.com”   ‘发邮件地址,自己改

Jmail.Subject = sSubject                  ‘主题
Jmail.AddRecipient MailTo        ‘收信人地址
Jmail.Body = sBody                      ‘信件正文

Jmail.Send (“Smtp.Qq.Com”)
DoEvents

Set Jmail = Nothing
‘————————————————
Exit Sub
‘—————-
ToExit:
ErrorTimes = ErrorTimes + 1
If ErrorTimes < 3 Then Resume
Select Case Jmail.ErrorCode
Case 550
MsgBox MailTo + “该邮件地址不存在,请更改后再发”, , “提示”
Case 535
MsgBox “发件人的用户名或密码错误,请改正后再发”, , “提示”
Case Else
‘MsgBox Jmail.ErrorMessage, , “提示”
End Select
SendError = True
End Sub

Private Sub Cmd_Info_Click()
MsgBox “本程序发送邮件必须是支持SMTP的!” & vbCrLf & “设置方法:” & vbCrLf & “1.打开QQ邮箱!” & vbCrLf & “”
End Sub

Private Sub Cmd_Send_Click()
If Txt_QQNum.Text = “” Or Txt_QQPwd.Text = “” Or Txt_SendTo.Text = “” Or Txt_Title.Text = “” Or Txt_Text.Text = “” Then
MsgBox “您可能少输入一项,请检查!”, vbCritical + vbOKOnly, “提示”
Exit Sub
End If

MailUserName = Txt_QQNum.Text
MailPassWord = Txt_QQPwd.Text
Me.MousePointer = 11

SendMail Txt_Title.Text, Txt_Text.Text, , Txt_SendTo.Text
MsgBox “发送完毕,请自行到QQ邮箱查看邮件!”, vbInformation + vbOKOnly

Me.MousePointer = 0
End Sub

Private Sub Form_Load()
Shell “regsvr32 jmail.dll /s”, vbNormalFocus
SendError = False
End Sub
用到的DLL文件下载(本地):http://ivysoft.tk/content/uploadfile/201108/ec602a0917bcf0723eb5b6b1dafc888920110829072109.rar

附件下载:
jmail.rar 115.21KB

相关文章

返回
    • salvador1968
    • 一月 24th, 2012

    Ride providence online oregon quotes. http://byvfim.com

  1. 暂无 Trackback

You must be logged in to post a comment.