SendMailSMTP

Dim Response As String, Reply As Integer, DateNow As String
Dim first As String, Second As String, Third As String
Dim Fourth As String, Fifth As String, Sixth 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
'Must set local port to 0 (Zero) or you can only send 1

'e-mail per program start

If Winsock1.State = sckClosed Then
'Check to see if socet is closed

DateNow = Format(Date, "Ddd") & _
", " & Format(Date, "dd Mmm YYYY") & " " & _
Format(Time, "hh:mm:ss") & "" & " -0600"
first = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf
'Get who's sending E-Mail address

Second = "rcpt to:" + Chr(32) + ToEmailAddress + vbCrLf
'Get who mail is going to

Third = "Date:" + Chr(32) + DateNow + vbCrLf
'Date when being sent

Fourth = "From:" + Chr(32) + FromName + vbCrLf
'Who's Sending

Fifth = "To:" + Chr(32) + ToNametxt + vbCrLf
'Who it going to

Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf
'Subject of E-Mail

Seventh = EmailBodyOfMessage + vbCrLf
'E-mail message body

Ninth = "X-Mailer: EBT Reporter v 2.x" + vbCrLf
'What program sent the e-mail, customize this

Eighth = Fourth + Third + Ninth + Fifth + Sixth
'Combine For proper SMTP sending

Winsock1.Protocol = sckTCPProtocol
'Set protocol For sending

Winsock1.RemoteHost = MailServerName
'Set the server address

Winsock1.RemotePort = 25
'Set the SMTP Port

Winsock1.Connect
'Start connection

WaitFor ("220")
StatusTxt.Caption = "Connecting...."
StatusTxt.Refresh
Winsock1.SendData ("HELO yourdomain.com" + 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)
Start = Timer
'Time Event so won't Get stuck in Loop

While Len(Response) = 0
Tmr = Start - Timer
DoEvents
'Let System keep checking For incoming response **IMPORTANT**

If Tmr > 50 Then
'Time in seconds to wait

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 Command1_Click()
SendEmail txtEmailServer.Text, txtFromName.Text, _
txtFromEmailAddress.Text, txtToEmailAddress.Text, _
txtToEmailAddress.Text, txtEmailSubject.Text, _
txtEmailBodyOfMessage.Text
'MsgBox ("Mail Sent")

StatusTxt.Caption = "Mail Sent"
StatusTxt.Refresh
Beep
Close
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Form_Load()
End Sub

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