电脑内并无安装OUTLOOK或其他邮件软体
是否能单纯使用VB6去寄信件~邮件伺服器使用公司内部的~
在可以寄~但是在VB6不知道怎么写?

CSDN查到这组代码~但是无法运作~
不知道Response是什麼東西老卡在這~
MsgTitle不知道是什麼東西~

Option Explicit

Dim Response As String
Dim Reply As Integer
Dim DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth As String, Ninth As String
Dim Seventh As String, Eighth As String
Dim Start As Single, Tmr As Single

Sub SendEmail(MailServerName As String, FromName As String, FromEmailAddress As String, ToName As String, _
              ToEmailAddress As String, EmailSubject As String, EmailBodyOfMessage As String)

    Winsock1.LocalPort = 0
        
    If Winsock1.State = sckClosed Then
    
        DateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
        first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
        Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
        Third = "Date:" + Chr(32) + DateNow + vbCrLf
        Fourth = "From:" + Chr(32) + FromName + vbCrLf
        Fifth = "To:" + Chr(32) + ToName + vbCrLf
        Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
        Seventh = EmailBodyOfMessage + vbCrLf
        
        Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf  
        Eighth = Fourth + Third + Ninth + Fifth + Sixth  
    
        Winsock1.Protocol = sckTCPProtocol 
        Winsock1.RemoteHost = MailServerName 
        Winsock1.RemotePort = 25
        Winsock1.Connect 
        
        WaitFor ("220")
        
        StatusTxt.Caption = "Connecting...."
        StatusTxt.Refresh
        
        Winsock1.SendData ("HELO " + vbCrLf)
    
        WaitFor ("250")
    
        StatusTxt.Caption = "Connected"
        StatusTxt.Refresh
        Winsock1.SendData (first)
        StatusTxt.Caption = "Sending Message"
        StatusTxt.Refresh
    
        WaitFor ("250")
    
        Winsock1.SendData (Second)
    
        WaitFor ("250")
    
        Winsock1.SendData ("data" + vbCrLf)
        
        WaitFor ("354")
        Winsock1.SendData (Eighth + vbCrLf)
        Winsock1.SendData (Seventh + vbCrLf)
        Winsock1.SendData ("." + vbCrLf)
    
        WaitFor ("250")
    
        Winsock1.SendData ("quit" + vbCrLf)
        
        StatusTxt.Caption = "Disconnecting"
        StatusTxt.Refresh
    
        WaitFor ("221")
    
        Winsock1.Close
    Else
        MsgBox (Str(Winsock1.State))
    End If
   
End Sub

Sub WaitFor(ResponseCode As String)
Dim MsgTitle As String
    Start = Timer
    While Len(Response) = 0
        Tmr = Start - Timer
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, timed out while waiting for response", 64, MsgTitle
            Exit Sub
        End If
    Wend
    While Left(Response, 3) <> ResponseCode
        DoEvents
        If Tmr > 50 Then
            MsgBox "SMTP service error, impromper response code." _
                & "Code should have been: " + ResponseCode + " Code recieved: " + Response, 64, MsgTitle
            Exit Sub
        End If
    Wend
Response = "" ' Sent response code to blank **IMPORTANT**
End Sub

Private Sub cmdSend_Click()
    SendEmail txtEmailServer.Text, txtFromName.Text, txtFromEmailAddress.Text, txtToName.Text, txtoEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
    'MsgBox ("Mail Sent")
    StatusTxt.Caption = "Mail Sent"
    StatusTxt.Refresh
    Beep
    Close
End Sub

Private Sub cmdExit_Click()
    End
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    Winsock1.GetData Response ' Check for incoming response *IMPORTANT*
End Sub

[此贴子已经被作者于2018-6-11 14:18编辑过]

Winsock只写过FTP传档案~没试过用来传邮件~

我觉得还是说一下~我是在XP上用VB6开发的Send Mail~
但是是要在Windows2012 R2上运作的~

[此贴子已经被作者于2018-6-11 14:23编辑过]

https://bbs.

代码出处~

结果成功了~之前收不到信的原因是~我同时开启两种网卡~一张公司内部的~一张苹果的~
结果苹果的一切掉~信就进来了~不过还得试试2012行不行~因为成功的不是用贴上的这个~

是用另一个元件Windows内建的CDO.Message~
CDOSYS.dll要去References这个DLL~再写代码~

经过确认此元件只要是Windows OS都能用，所有版本此DLL可供使用，当然也包含Server版OS〜
泛用性比.Net还更广泛，且不需要装任何编译器或SDK或修补档，即可直接使用〜

[此贴子已经被作者于2018-6-14 04:00编辑过]

我是用CDOSYS.DLL代码很短对Exchange Server

    strYouEmail = "123@" '也能群组寄信
    strCCEmail = "234@"
    sch = "http://schemas."
    Set cdoConfig = CreateObject("CDO.Configuration")
    With cdoConfig
        .Fields.Item(sch & "sendusing") = 2 '## (1) 使用 local SMTP, (2) 为外部 SMTP
        .Fields.Item(sch & "smtpserver") = MAILGATE '## 您的网址
        .Fields.Item(sch & "smtpserverport") = 25 '## SMTP Server Port (预设即为 25)
        .Fields.Update
    End With
    
    Set cdoMessage = CreateObject("CDO.Message")
    With cdoMessage
        Set .Configuration = cdoConfig
        .From = "通知信 <" & strYouEmail & ">"
        .To = strYouEmail '## 收件者
        .CC = strCCEmail '## 副本
'       .BCC = strYouEmail '## 密件副本
        .Subject = "TD FTP TXT Path Error"
'       .HTMLBody = "信件内容" '## HTML 网页格式信件
        .TextBody = Temp '## 文字格式信件内容
'       .AddAttachment "C:\123.JPG" '## 附加档案
        .Send
    End With
    Set cdoMessage = Nothing
    Set cdoConfig = Nothing

引用自 :
http://www.

透过 Gmail SMTP 发信也行

[此贴子已经被作者于2018-6-19 11:28编辑过]