Hi Guy (and everyone who is listening!!!)
While I was looking for the doc, I found a code sample of how to use Winsock to send mail. As you will, it is close to the code you paste me. I have tried this sample and it works very well.
You can be sure that I will remember this one!!! And I hope that everyone will copy it because it is very simple to bypass MAPI (for users which are always connected to the Net).
Here it is:
Option Explicit
'Description:Allows sending of e-mail (SMTP) directly from
'VB app using Winsock, WITH OUT having to buy an expensive
'on component
'//Input Requirements: Server Address (Name or IP), Senders & //Recipeient's Names, Sender & Recipient E-Mail address, Body of //message
Private mstrResponse As String
Private Sub SendEmail(ByVal pstrMailServerName As String, _
ByVal pstrFromEmailAddress As String, _
ByVal pstrToEmailAddress As String, _
ByVal pstrEmailSubject As String, _
ByVal pstrEmailBodyOfMessage As String)
Dim strDateNow As String
Dim strFirst As String
Dim strSecond As String
Dim strThird As String
Dim strFourth As String
Dim strFifth As String
Dim strSixth As String
Dim strSeventh As String
Dim strEighth As String
Dim strNinth As String
Winsock1.LocalPort = 0 ' Must set local port to 0 (Zero) or you can only send 1 e-mail per program start
strDateNow = Format(Date, "Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & Format(Time, "hh:mm:ss") & "" & " -0600"
strFirst = "mail from:" + Chr(32) + pstrFromEmailAddress + vbCrLf ' Get who's sending E-Mail address
strSecond = "rcpt to:" + Chr(32) + pstrToEmailAddress + vbCrLf ' Get who mail is going to
strThird = "Date:" + Chr(32) + strDateNow + vbCrLf ' Date when being sent
strFourth = "From:" + Chr(32) + pstrFromEmailAddress + vbCrLf ' Who's Sending
strFifth = "To:" + Chr(32) + pstrToEmailAddress + vbCrLf ' Who it going to
strSixth = "Subject:" + Chr(32) + pstrEmailSubject + vbCrLf ' Subject of E-Mail
strSeventh = pstrEmailBodyOfMessage + vbCrLf ' E-mail message body
strNinth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf ' What program sent the e-mail, customize this
strEighth = strFourth + strThird + strNinth + strFifth + strSixth ' Combine for proper SMTP sending
With Winsock1
If .State = sckClosed Then ' Check to see if socet is closed
.Protocol = sckTCPProtocol ' Set protocol for sending
.RemoteHost = pstrMailServerName ' Set the server address
.RemotePort = 25 ' Set the SMTP Port
.Connect ' Start connection
WaitFor ("220")
lblStatus.Caption = "Connecting...."
lblStatus.Refresh
.SendData ("HELO worldcomputers.com" + vbCrLf)
WaitFor ("250")
lblStatus.Caption = "Connected"
lblStatus.Refresh
.SendData (strFirst)
lblStatus.Caption = "Sending Message"
lblStatus.Refresh
WaitFor ("250")
.SendData (strSecond)
WaitFor ("250")
.SendData ("data" + vbCrLf)
WaitFor ("354")
.SendData (strEighth + vbCrLf)
.SendData (strSeventh + vbCrLf)
.SendData ("." + vbCrLf)
WaitFor ("250")
.SendData ("quit" + vbCrLf)
lblStatus.Caption = "Disconnecting"
lblStatus.Refresh
WaitFor ("221")
.Close
Else
MsgBox (Str(.State))
End If
End With
End Sub
Sub WaitFor(strResponseCode As String)
Dim sngStart As Single
Dim sngTmr As Single
sngStart = Timer ' Time event so won't get stuck in loop
While Len(mstrResponse) = 0
sngTmr = sngStart - Timer
DoEvents ' Let System keep checking for incoming response **IMPORTANT**
If sngTmr > 50 Then ' Time in seconds to wait
MsgBox "SMTP service error, timed out while waiting for response", 64
Exit Sub
End If
Wend
While Left$(mstrResponse, 3) <> strResponseCode
DoEvents
If sngTmr > 50 Then
MsgBox "SMTP service error, impromper response code. Code should have been: " + strResponseCode + " Code recieved: " + mstrResponse, 64
Exit Sub
End If
Wend
mstrResponse = "" ' Sent response code to blank **IMPORTANT**
End Sub
Private Sub Command1_Click()
lblStatus.Caption = ""
lblStatus.Refresh
SendEmail txtEmailServer.Text, txtFromEmailAddress.Text, txtToEmailAddress.Text, txtEmailSubject.Text, txtEmailBodyOfMessage.Text
lblStatus.Caption = "Mail Sent"
lblStatus.Refresh
End Sub
Private Sub Command2_Click()
End
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Winsock1.GetData mstrResponse ' Check for incoming response *IMPORTANT*
End Sub
Éric Moreau, MCPD, Visual Developer - Visual Basic MVP
Conseiller Principal / Senior Consultant
Moer inc.
http://www.emoreau.com