加入收藏 | 设为首页 | 会员中心 | 我要投稿 李大同 (https://www.lidatong.com.cn/)- 科技、建站、经验、云计算、5G、大数据,站长网!
当前位置: 首页 > 百科 > 正文

VB发邮件1

发布时间:2020-12-17 08:21:06 所属栏目:百科 来源:网络整理
导读:'///////////////////////////////////////////'' 本程序为简邮邮件组件的演示程序'' 作者: 三毛' QQ:510784518' 博客:http://hi.baidu.com/suruiqiang''///////////////////////////////////////////Option ExplicitPrivate Declare Function SendMail Lib
'///////////////////////////////////////////
'
'   本程序为简邮邮件组件的演示程序
'
'   作者:    三毛
'   QQ:510784518
'   博客:http://hi.baidu.com/suruiqiang
'
'///////////////////////////////////////////
Option Explicit

Private Declare Function SendMail Lib "smtp.dll" (ByVal StrSmtpServer As String,ByVal StrUser As String,ByVal StrPass As String,ByVal StrMailFrom As String,ByVal StrMailTo As String,ByVal StrSubject As String,ByVal StrBodyMsg As String) As Long
Private Declare Function GetSmtpError Lib "smtp.dll" (ByVal StrErrMsg As String) As Long

Private Sub CmdSend_Click()
    Dim StrErrMsg As String
    
    If CobServer.Text = "" Then
        MsgBox "请输入SMTP服务器",vbInformation,"输入不完整"
        Exit Sub
    End If
    If TxtUser.Text = "" Then
        MsgBox "请输入你的用户名","输入不完整"
        Exit Sub
    End If
    
    If TxtPass.Text = "" Then
        MsgBox "请输入你的密码","输入不完整"
        Exit Sub
    End If
    
    If TxtMailFrom.Text = "" Then
        MsgBox "请输入发件人邮箱,发件人邮箱必须和SMTP服务器及你的用户名匹配","输入不完整"
        Exit Sub
    End If
    
    If TxtMailTo.Text = "" Then
        MsgBox "请输入收件人邮箱","输入不完整"
        Exit Sub
    End If
    
    If TxtSubject.Text = "" Then
        MsgBox "请输入邮件标题","输入不完整"
        Exit Sub
    End If
    
    If TxtBodyMsg.Text = "" Then
        MsgBox "邮件正文不能为空","输入不完整"
        Exit Sub
    End If
    
    If SendMail(Trim(CobServer.Text),TxtUser.Text,TxtPass.Text,TxtMailFrom.Text,TxtMailTo.Text,TxtSubject.Text,TxtBodyMsg.Text) Then
        MsgBox "邮件发送成功",vbInformation
    Else
        StrErrMsg = Space(100)    '填充缓冲区 这句是必须的 不要遗漏
        GetSmtpError StrErrMsg
        MsgBox StrErrMsg,"邮件发送失败"
    End If
End Sub

Private Sub CobServer_Change()
    TxtMailFrom.Text = TxtUser.Text & "@" & IIf(Left(CobServer.Text,5) = "smtp.",Mid(CobServer.Text,6),CobServer.Text)
End Sub

Private Sub CobServer_Click()
    TxtMailFrom.Text = TxtUser.Text & "@" & IIf(Left(CobServer.Text,CobServer.Text)
End Sub

Private Sub TxtUser_Change()
    TxtMailFrom.Text = TxtUser.Text & "@" & IIf(Left(CobServer.Text,CobServer.Text)
End Sub

(编辑:李大同)

【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!

    推荐文章
      热点阅读