Sub Command1_Click()
SendEmail "dinserver.se", "dittnamn", "pelle@interpress.se", _
"SAND OnLine user", "dinadress@abc.se", _
"Winsock SMPT test", "Hej och tack!" & chr(10)
End Sub

' Addera denna kod till Winsock1_DataArrival händelsen
Sub Winsock1_DataArrival()
Winsock1.GetData Response
End Sub

' Denna rutin väntar på att SMTP servern skall returnera en returkod innan SMTP rutinen kan starta och sända mail.

Sub WaitFor(ResponseCode As String)
Dim tmr As Long
While Len(Response) = 0
DoEvents
If tmr > 50 Then
MsgBox "SMTP service error, unable to get a response1", 64, MsgTitle
Exit Sub
End If
Wend

While left(Response, 3) <> ResponseCode
DoEvents
If tmr > 50 Then
MsgBox "SMTP service error, unable to get a response2", 64, MsgTitle
Exit Sub
End If
Wend
End Sub

'Denna subrutin är den som innehåller själva kärnan. Se vad som händer 'direkt efter du sänt datat. Du får en sträng som måste kontrolleras om 'något fel uppstått efter att datat sänts.
Sub WaitFor2(ResponseCode As String)
Dim tmr As Long
tmr = Timer
While Len(Response) = 0
If tmr > 50 Then
MsgBox "SMTP service error, unable to get a response3", 64, MsgTitle
Exit Sub
End If
Unload Techsup
DoEvents
Wend

'Reply = InStr(Response, "354 ")

While Reply = 0
Reply = InStr(Response, ResponseCode)
DoEvents
Wend
End Sub

'Här är hjärtat av SMTP rutinen. Det finns några argument som du måste 'använda för att skicka mailet. Ett problem som säkert kommer att dyka 'upp, är att du måste finna en mailserver som sänder ditt mail. Men konto 'borde du ha hos din service provider.

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

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: DevPatch Tech Support Form" + vbCrLf
Eighth = Fourth + third + Ninth + Fifth + Sixth + Seventh

Winsock1.Protocol = sckTCPProtocol
Winsock1.RemoteHost = MailServerName
Winsock1.RemotePort = 25
Winsock1.Connect
WaitFor ("220")

Winsock1.SendData ("HEJ microsoft.com" + vbCrLf)
WaitFor ("250")
Winsock1.SendData (first)
WaitFor ("250")
Winsock1.SendData (Second)
WaitFor ("250")
Winsock1.SendData ("data" + vbCrLf)
WaitFor2 ("354 ")

Winsock1.SendData (Eighth)
Winsock1.SendData ("." + vbCrLf)

WaitFor ("250")

Winsock1.SendData ("quit")
WaitFor ("221")

Winsock1.Close

End Sub