VB6要如何发信
电脑内并无安装OUTLOOK或其他邮件软体是否能单纯使用VB6去寄信件~邮件伺服器使用公司内部的~
在可以寄~但是在VB6不知道怎么写?
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编辑过]
[此贴子已经被作者于2018-6-14 04:00编辑过]
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
[此贴子已经被作者于2018-6-19 11:28编辑过]