Public SMTPHost As String

IP address or domain name of the SMTP server or host. An example of this would be smtp.codeoftheweek.com

Public SMTPPort As Long

The SMTP port number of the SMTP server. The default is 25.

Public DomainName As String

This is the domain you are sending your email from. This should be something like abc.com or hotmail.com

Public FromUsername As String

Your fully qualified username. It should be in the format user@domain.com

Public ToUsername As String

The fully qualified username you are sending mail to.

Public MessageText As String

Any message text. It can contain carriage return/line feeds to support multi-line messages.

Public Subject As String

The subject of the message you are sending.

Public WithEvents WinSockControl As Winsock

Public Sub SendMessage()

This sample will send a message to the smtp.codeoftheweek.com mail server. It will be addressed to billgates@microsoft.com and from info@codeoftheweek.com. It assumes you have a form called Form1 which has the WinSock control on it called wsControl.

    Dim SMTP As New cSimpleSMTP

    Set SMTP.WinSockControl = Form1.wsControl
    SMTP.SMTPHost = "smtp.codeoftheweek.com"
    SMTP.DomainName = "codeoftheweek.com"
    SMTP.FromUsername = "info@codeoftheweek.com"
    SMTP.ToUsername = "billgates@microsoft.com"
    SMTP.Subject = "Where's VB7?"
    SMTP.MessageText = "Bill, Please get VB7 out ASAP.  Thanks, COTW"
    SMTP.SendMessage

Create a new class module and paste this source code into it. You should name this class cSimpleSMTP. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cSimpleSMTP
'   Written By:     C&D Programming Corp.
'   Create Date:    4/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
'
'   Enhancements to make this more robust:
'       - Timeout errors within the SendData and RecData functions
'         it should eventually error out with a sckError, but it
'         would be nice to make it user controllable.
'       - Better mechanism to filter the error messages up to the
'         client.
'       - Add ability to send attachments (although that would
'         be more than "SimpleSMTP")
'       - Ability to send to multiple recipients
'
'
'
'   Sample Usage:
'
'    Dim SMTP As New cSimpleSMTP
'
'    Set SMTP.WinSockControl = Form1.wsControl
'    SMTP.SMTPHost = "smtp.codeoftheweek.com"
'    SMTP.DomainName = "codeoftheweek.com"
'    SMTP.FromUsername = "info@codeoftheweek.com"
'    SMTP.ToUsername = "billgates@microsoft.com"
'    SMTP.Subject = "Where's VB7?"
'    SMTP.MessageText = "Bill, Please get VB7 out ASAP.  Thanks, COTW"
'    SMTP.SendMessage
'
'

Option Explicit

' GetTickCount returns the number of milliseconds that Windows
' since Windows has started.
'
' The internal timer will wrap around to zero if Windows is
' run continuously for approximately 49 days.
'
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public SMTPHost As String           ' IP address or domain name
Public SMTPPort As Long             ' port number of the SMTP server. Default is 25.
Public DomainName As String         ' like abc.com (this is the domain you are sending from)
Public FromUsername As String       ' any username in the format abc@abc.com
                                    ' should be your username.
Public ToUsername As String         ' any username in the format abc@abc.com
Public Subject As String            ' any text string
Public MessageText As String        ' any message text

' Winsock control which was dropped on a form
'
Public WithEvents WinSockControl As Winsock

' some status flags to make it easier to manage certain states.
Private mbSendComplete As Boolean
Private mbRecComplete As Boolean

Private Sub LogMessage(sData As String)
    Debug.Print sData
    ' you can do anything you need to here to save the log data or
    ' dump it into a text box or something like that.
    ' maybe raise an event to show status messages to a client application.
End Sub

Private Sub WinSockControl_DataArrival(ByVal bytesTotal As Long)
    Dim sData As String
    Dim lCode As Long

    WinSockControl.GetData sData, vbString, bytesTotal
    On Error Resume Next
    lCode = Val(sData)  ' will return non-zero if the string begins with a
                        ' number.  We trap for an error just in case someone
                        ' tries to send a very large numeric string.  We do
                        ' not want this routine to crash out.
    If Err Then
        lCode = 0
    End If
    On Error GoTo 0
    LogMessage "Received " & bytesTotal & " bytes of data."
    LogMessage "Status Code: " & lCode  ' useful for working with the SMTP host
    LogMessage "Raw Data: " & sData
    mbRecComplete = True
End Sub

Private Sub WinSockControl_SendComplete()
    mbSendComplete = True
    mbRecComplete = False
End Sub

Public Sub SendMessage()
    Dim sData As String
    Dim sMsg As String
    Static bInRoutine As Boolean

    If bInRoutine Then
        Err.Raise 5, "SendMessage", "Already in process of sending message."
    End If
    bInRoutine = True
    WinSockControl.RemoteHost = SMTPHost
    WinSockControl.RemotePort = SMTPPort
    WinSockControl.Connect
    If WaitFor(sckConnected) Then
        SendData "HELO " & DomainName & vbCrLf
        RecData
        SendData "MAIL FROM: " & FromUsername & vbCrLf
        RecData
        SendData "RCPT TO: " & ToUsername & vbCrLf
        RecData
        SendData "DATA" & vbCrLf
        RecData
        SendData "Subject: " & Subject & vbCrLf & MessageText & vbCrLf & "." & vbCrLf
        RecData
        SendData "QUIT" & vbCrLf
        RecData
    End If
    Wait 2  ' let's make sure the data is completely sent.
    WinSockControl.Close
    bInRoutine = False
    Exit Sub

Handler:
    bInRoutine = False
    Err.Raise Err.Number, "SendMessage", Err.Description
    If WinSockControl.State <> sckClosed Then
        WinSockControl.Close
    End If
End Sub

Private Function RecData() As Boolean
    While Not mbRecComplete And WinSockControl.State <> sckError
        DoEvents
    Wend
End Function

Private Function SendData(sData As String)
    mbSendComplete = False
    WinSockControl.SendData sData
    While Not mbSendComplete And WinSockControl.State <> sckError
        DoEvents
    Wend
End Function

Private Function WaitFor(lState As Long) As Boolean
    While WinSockControl.State <> lState And WinSockControl.State <> sckError
        DoEvents
    Wend
    If WinSockControl.State = sckError Then
        WaitFor = False
    Else
        WaitFor = True
    End If
End Function

Private Sub Class_Initialize()
    SMTPPort = 25
End Sub

Private Sub WinSockControl_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    LogMessage "error: " & Number & " - " & Description & " source: " & Source
End Sub

Private Sub WinSockControl_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
    LogMessage "sending: " & bytesSent & " remaining: " & bytesRemaining
End Sub

Private Sub WinSockControl_Close()
    LogMessage "closed"
End Sub

Private Sub WinSockControl_Connect()
    LogMessage "connected"
End Sub

Private Sub WinSockControl_ConnectionRequest(ByVal requestID As Long)
    LogMessage "connection request " & requestID
End Sub

'----------------------------------------------------------------------
'
'   Module Name:    basWait - integrated into cSimpleMAPI for
'                   ease of distribution.
'   Written By:     C&D Programming Corp.
'   Create Date:    5/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------

Public Function Wait(ByVal lSeconds As Long, _
                     Optional ByRef bAbortFlag As Boolean = False, _
                     Optional ByRef lElapsed As Long) As Boolean

    Dim lStartTime As Long

    lStartTime = GetTickCount
    lElapsed = 0
    While (lElapsed < lSeconds) And (Not bAbortFlag)
        ' Convert to seconds (use integer math for extra speed
        lElapsed = (GetTickCount - lStartTime) \ 1000
        DoEvents
    Wend
    Wait = Not bAbortFlag
End Function