谁有成功发送邮件的方法？？

Question

我在网上找了很多这方面的资料和源程序，但都不能成功发送。所请回贴时，请先测试一下，不要随便从别的地方转贴过来，谢谢！！

Answer 1

如果你看得懂C++，那偶这里就有，不过是Borland C++ Builder的代码，虽然跟VB没多大差别，不过偶不写VB代码。

Answer 2

慷慨的朋友发个给我试用：[email protected] 谢谢!

Answer 3

clsmail.cls
Option Explicit
Private WithEvents Sock As MSWinsockLib.Winsock
Attribute Sock.VB_VarHelpID = -1Private StrCharset As String                    '语言编码
Private StrContentType As String                '邮件编码
Private StrServerAddress As String              'SMTP服务器地址
Private StrMailServerUserName As String         'SMTP验证用户名
Private StrMailServerPassword As String         'SMTP验证密码
Private StrFrom As String                       '发信人地址
Private StrFromName As String                   '发信人姓名
Private StrSubject As String                    '邮件标题
Private StrBody As String                       '邮件内容
Private StrRecipient As String                  '收件人地址
Private LngPriority As Long                     '邮件级别
Private LngPort As Long                         'SMTP服务器端口Private ErrInt As Integer
Private ErrStr As String'语言编码
Public Property Let Charset(ByVal Str As String)
    StrCharset = Str
End Property'邮件编码
Public Property Let ContentType(ByVal Str As String)
    StrContentType = Str
End Property'SMTP服务器地址
Public Property Let ServerAddress(ByVal Str As String)
    StrServerAddress = Str
End Property'SMTP服务器端口
Public Property Let Port(ByVal II As Long)
    LngPort = II
End Property'SMTP验证用户名
Public Property Let MailServerUserName(ByVal Str As String)
    StrMailServerUserName = Base64(Trim(Str))
End Property'SMTP验证密码
Public Property Let MailServerPassword(ByVal Str As String)
    StrMailServerPassword = Base64(Str)
End Property'发信人地址
Public Property Let From(ByVal Str As String)
    StrFrom = Str
End Property'发信人姓名
Public Property Let FromName(ByVal Str As String)
    StrFromName = Str
End Property'邮件标题
Public Property Let Subject(ByVal Str As String)
    StrSubject = Str
End Property'收件人地址,可以多个收件人,如有多个收件人以“;”号分隔
Public Sub AddRecipient(ByVal Str As String)
    StrRecipient = Str
End Sub'邮件内容
Public Property Let Body(ByVal Str As String)
    StrBody = Str
End Property'邮件级别
Public Property Let Priority(ByVal II As Long)
    LngPriority = II
End Property'应该在执行过可能产生错误的函数后及时调用此函数，获取最新的错误信息。
Public Property Get OnErr() As Integer
    OnErr = ErrInt
End Property
Public Property Get Description() As String
    Description = ErrStr
End PropertyPrivate Sub Class_Initialize()
Set Sock = New MSWinsockLib.Winsock
End SubPrivate Sub Class_Terminate()
Sock.Close
Set Sock = Nothing
End SubPublic Sub Send() '发送
    If LngPort < 1 Then LngPort = 25
    If LngPriority < 1 Or LngPriority > 5 Then LngPriority = 2
    If StrCharset = "" Then StrCharset = "GB2312"
    If StrContentType = "" Then StrContentType = "Text/Html"
    If Right(StrRecipient, 1) <> ";" Then StrRecipient = StrRecipient & ";"    Sock.Close '关闭连接
    Sock.Connect StrServerAddress, LngPort '连接邮件服务器
End SubPrivate Sub Sock_DataArrival(ByVal bytesTotal As Long)
    Dim StrServerResponse  As String '服务器返回的信息
    Dim StrResponseCode As String
    Dim StrRe() As String
    Dim II As Long    Const RandString As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_"
    Dim GlobalStr As String
    For II = 1 To 24
        GlobalStr = GlobalStr & Mid(RandString, Int(Rnd * Len(RandString)) + 1, 1)
    Next II
    
    '获取邮件服务器返回信息
    Sock.GetData StrServerResponse
    StrResponseCode = Left(StrServerResponse, 3)
    
    '登陆邮件服务器,SMTP验证
    Sock.SendData "HELO " & Trim$(StrFrom) & vbCrLf
    Sock.SendData "AUTH LOGIN" & vbCrLf
    Sock.SendData (StrMailServerUserName) & vbCrLf
    Sock.SendData (StrMailServerPassword) & vbCrLf
        
    StrRe = Split(StrRecipient, ";")
    For II = 0 To UBound(StrRe) - 1 '发送到多个收件人    If StrResponseCode = "250" Or _
       StrResponseCode = "220" Or _
       StrResponseCode = "354" Or _
       StrResponseCode = "334" Or _
       StrResponseCode = "235" Then
        Sock.SendData "MAIL FROM:" & Trim$(StrFrom) & vbCrLf '寄件人
        Sock.SendData "RCPT TO:" & Trim$(StrRe(II)) & vbCrLf '收件人
        Sock.SendData "DATA" & vbCrLf
        Sock.SendData "From: " & StrFromName & "<" & StrFrom & ">" & vbCrLf '寄件人
        Sock.SendData "To: " & Mid(StrRe(II), 1, InStr(StrRe(II), "@") - 1) & "<" & StrRe(II) & ">" & vbCrLf '收件人
        Sock.SendData "Subject:" & Chr(32) & StrSubject & vbCrLf '邮件主题
        Sock.SendData "X-Mailer: SkyGz MAIL1.0" & vbCrLf '邮件发送者
        Sock.SendData "X-Priority: " & CStr(LngPriority) & vbCrLf '邮件发送级别
        Sock.SendData "MIME-Version: 1.0" & vbCrLf
        Sock.SendData "Content-Type: multipart/alternative;" & vbCrLf & Chr(9) & "boundary=""----=_NextPart_" & GlobalStr & """" & vbCrLf & vbCrLf
        Sock.SendData "This Is A Multi-Part Message In MIME Format." & vbCrLf & vbCrLf
        Sock.SendData "------=_NextPart_" & GlobalStr & vbCrLf
        Sock.SendData "Content-Type: " & StrContentType & "; charset=" & StrCharset & ";" & vbCrLf & vbCrLf '语言编码和邮件编码
        Sock.SendData StrBody & vbCrLf & vbCrLf '邮件内容
        Sock.SendData "------=_NextPart_" & GlobalStr & "--" & vbCrLf
        Sock.SendData "." & vbCrLf
        ErrInt = 3
        ErrStr = "发送成功"
        'Sock.Close
        'Send = True
    Else
        ErrInt = 4
        ErrStr = "发送失败"
        'Sock.Close
        'Send = False
    End If
    Next II
        Sock.SendData "QUIT" & vbCrLf '退出邮件服务器
End SubPrivate Function Base64(ByVal Str As String) As String 'base6加密算法
    Const BASE64_TABLE As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim StrTempLine As String
    Dim j As Integer
    For j = 1 To (Len(Str) - Len(Str) Mod 3) Step 3
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1)) \ 4) + 1, 1)
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, ((Asc(Mid(Str, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(Str, j + 1, 1)) \ 16) + 1, 1)
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, ((Asc(Mid(Str, j + 1, 1)) Mod 16) * 4 _
                      + Asc(Mid(Str, j + 2, 1)) \ 64) + 1, 1)
        StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j + 2, 1)) Mod 64) + 1, 1)
    Next j
    If Not (Len(Str) Mod 3) = 0 Then
         If (Len(Str) Mod 3) = 2 Then
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1)) \ 4) + 1, 1)
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1)) Mod 4) * 16 _
                      + Asc(Mid(Str, j + 1, 1)) \ 16 + 1, 1)
             StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j + 1, 1)) Mod 16) * 4 + 1, 1)
            StrTempLine = StrTempLine & "="
        ElseIf (Len(Str) Mod 3) = 1 Then
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, Asc(Mid(Str, j, 1)) \ 4 + 1, 1)
            StrTempLine = StrTempLine + Mid(BASE64_TABLE, (Asc(Mid(Str, j, 1)) Mod 4) * 16 + 1, 1)
             StrTempLine = StrTempLine & "=="
        End If
     End If
    Base64 = StrTempLine
End Function

Answer 4

Frmmain.frmOption Explicit
Private Mail As ClsMailPrivate Sub CmdSend_Click()
Call SendMail(TxtCharset.Text, _
              CbContentType.Text, _
              TxtFrom.Text, _
              TxtFromName.Text, _
              Txtre.Text, _
              TxtUserName.Text, _
              TxtPassword.Text, _
              CLng(CbPriority.Text), _
              TxtAddr.Text, _
              TxtSubject.Text, _
              TxtBody.Text)Command1.Enabled = True
End SubPrivate Sub Command1_Click()
MsgBox Mail.Description, 64, Me.Caption
End SubPrivate Sub Form_Load()
CbPriority.AddItem "1"
CbPriority.AddItem "2"
CbPriority.AddItem "3"
CbPriority.AddItem "4"
CbPriority.AddItem "5"
CbPriority.ListIndex = 1
Set Mail = New ClsMail
End SubPrivate Sub SendMail(ByVal Charset As String, _
                     ByVal ContentType As String, _
                     ByVal From As String, _
                     ByVal FromName As String, _
                     ByVal Recipient As String, _
                     ByVal UserName As String, _
                     ByVal Password As String, _
                     ByVal Priority As Long, _
                     ByVal Addr As String, _
                     ByVal Subject As String, _
                     ByVal Body As String)
Mail.Charset = Charset '邮件编码
Mail.ContentType = ContentType '内容编码
Mail.From = From '发件人地址
Mail.FromName = FromName '发件人名称
Mail.AddRecipient Recipient '接收者邮件地址
Mail.MailServerUserName = UserName 'SMTP用户名
Mail.MailServerPassword = Password 'SMTP密码
Mail.Priority = Priority '优先级
Mail.ServerAddress = Addr 'Smtp服务器地址
Mail.Subject = Subject '邮件主题
Mail.Body = Body '邮件内容
Mail.Send '发送
End SubPrivate Sub Form_Unload(Cancel As Integer)
Set Mail = Nothing
End Sub

Answer 5

以上源码http://17990.playicq.com/1/23451.html

Answer 6

Option ExplicitPrivate Sub Command1_Click()
    MAPISession1.SignOn
    MAPIMessage1.SessionID = MAPISession1.SessionID
    Form1.Caption = "&Oacute;&Atilde;&raquo;§" + Str(MAPISession1.SessionID) + "&micro;&Ccedil;&Acirc;&frac12;&sup3;&Eacute;&sup1;&brvbar;"
    Indexno.Text = 1
End SubPrivate Sub Command2_Click()
    MAPISession1.SignOff
    Form1.Caption = "&Oacute;&Atilde;&raquo;§&Iacute;&Euml;&sup3;&ouml;"
End SubPrivate Sub Command3_Click()    MAPIMessage1.Compose
    MAPIMessage1.RecipDisplayName = "[email protected]"
    MAPIMessage1.AddressResolveUI = True
    MAPIMessage1.MsgSubject = Subject.Text
    MAPIMessage1.MsgNoteText = Content.Text
    MAPIMessage1.Send
    Form1.Caption = Form1.Caption + "        ·&cent;&Euml;&Iacute;&sup3;&Eacute;&sup1;&brvbar;"
End SubPrivate Sub Getmail_Click()
    MAPIMessage1.Fetch
    Form1.Caption = MAPIMessage1.MsgCount
    MAPIMessage1.MsgIndex = CInt(Indexno.Text)
    Content.Text = MAPIMessage1.MsgNoteText
    Subject.Text = MAPIMessage1.MsgSubject
    If Val(Indexno.Text) < Val(Me.Caption) - 1 Then
        Indexno.Text = Val(Indexno.Text) + 1
    End If
End Sub

Answer 7

http://www.chenoe.com/blog/blogview.asp?logID=936
http://www.chenoe.com/blog/blogview.asp?logID=604
http://www.chenoe.com/blog/blogview.asp?logID=1569

Answer 8

Private Sub StartProcess()
    
    With MAPIMessages1
        .MsgIndex = -1
        .RecipDisplayName = "AA"
        .RecipAddress = "[email protected]"
        .AddressResolveUI = True
        .SessionID = MAPISession1.SessionID
        .MsgSubject = "A"
        .MsgNoteText = "使用Excel可以打开"
        .AttachmentPathName = "F:\TEST.XLS"  '这里就可以加上附件的地址
        .Send
    End With
    MsgBox "生成完毕！"
    Exit Sub
ErrHandle:
    MsgBox Err.Description
End SubPrivate Sub Command1_Click()
    '方法:
    'MAPI控件是两个控件的组合：MAPISession控件和 MAPIMessage控件.
    '若不在“工具箱”则选择“工程”菜单中的“部件”命令，在部件对话框中选中“Microsoft MAPI Controls 6.0”并单击“确定”按钮。
    '使用MAPI控件包括两个步骤：用MAPISession控件登录并建立MAPI会话，然后用MAPIMessages控件的各种属性和方法访问和管理个人的收件箱。
    StartProcess
End SubPrivate Sub Form_Load()
    MAPISession1.SignOn
End SubPrivate Sub Form_Unload(Cancel As Integer)
    MAPISession1.SignOff
End Sub

Answer 9

使用这段代码的前提是你的机器上配置好了OutLook。