Although it has quite a few quirks, the SendEmail() method from David Winslow's former coworker isn't too bad on its own. Some might even say it's impressive that he did low-level SMTP communication in Visual Basic 6, despite the ease of use of CDO, MAPI, and a var-i-e-ty of third-party email components. But what struck me about this code was the combination of the author's insistence that this was the only way to reliably send email from VB6 and the fact that his code was completely unreliable and buggy, sending emails hours late, if ever. 

Public Response As String
Dim 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, Ninth As String
Dim Start As Single, Tmr As Single, Xer As Integer

Public Function SendEmail( _
          MailServer As String, FromEmailAddress As String, _
          ToEmailAddress As String, EmailSubject As String, _
          EmailBodyOfMessage As String) As Integer
  
  Dim tmpArr As Variant, ArrLen As Integer, I As Integer

  frmAction.Winsock1.Close

  On Error GoTo SMTPBusy

  ' Must set local port to 0 (Zero) or you can only send 
  '   1 e-mail pre program start
  frmAction.Winsock1.LocalPort = 0 
   
  ' Check to see if socet is closed
  If frmAction.Winsock1.State = sckClosed Then 
   
    'DateNow = Now() 
      'Format(Now(), "YYYY/MM/DD HH:NN:SS") 
      'Format(Date,"Ddd") & ", " & Format(Date, "dd Mmm YYYY") & " " & _
        ' Format(Time, "hh:mm:ss") & "" & " -0600"
    
    ' Get who's sending E-Mail address
    First = "mail from:" + Chr(32) + FromEmailAddress + vbCrLf 

    Fourth = "From:" + Chr(32) + FromEmailAddress + vbCrLf ' Who's Sending
    Sixth = "Subject:" + Chr(32) + EmailSubject + vbCrLf ' Subject of E-Mail
    Seventh = EmailBodyOfMessage + vbCrLf ' E-mail message body
    ' What program sent the e-mail, customize this
    Ninth = "X-Mailer: TPS Reporter v 3.x" + vbCrLf 
    ' Combine for proper SMTP sending
    Eighth = Fourth + Third + Ninth + Fifth + Sixth  

    If InStr(1, ToEmailAddress, ";") > 0 Then
      tmpArr = Split(ToEmailAddress, ";")
      ArrLen = UBound(tmpArr)
    Else
      ReDim tmpArr(0)
      tmpArr(0) = ToEmailAddress
      ArrLen = 0
    End If
   
    For I = 0 To ArrLen
      ' Get who mail is going to
      Second = "rcpt to:" + Chr(32) + tmpArr(I) + vbCrLf 
      'Third = "Date:" + Chr(32) + DateNow + vbCrLf ' Date when being sent
      Fifth = "To:" + Chr(32) + " " + vbCrLf ' Who it going to
       
      frmAction.Winsock1.Protocol = sckTCPProtocol  ' Set protocol for sending
       
      frmAction.Winsock1.RemoteHost = MailServer ' Set the server address
      frmAction.Winsock1.RemotePort = 25 ' Set the SMTP Port
      frmAction.Winsock1.Connect ' Start connection
       
      WaitFor "220", "Start Connection"
      Sleep 2
       
      frmAction.Winsock1.SendData ("HELO initech-global.com" + vbCrLf)
      WaitFor "250", "HELO initech-global.com"
       
      Sleep 2
       
      frmAction.Winsock1.SendData (First)
      WaitFor "250", First
      Sleep 2
       
      frmAction.Winsock1.SendData (Second)
      WaitFor "250", Second
      Sleep 2
       
      frmAction.Winsock1.SendData ("data" + vbCrLf)
      WaitFor "354", "data"
      Sleep 2
       
      frmAction.Winsock1.SendData (Eighth + vbCrLf)
      frmAction.Winsock1.SendData (Seventh + vbCrLf)
      frmAction.Winsock1.SendData ("." + vbCrLf)
      WaitFor "250", Eighth & "|" & Seventh & "|."
      Sleep 2
       
      frmAction.Winsock1.SendData ("quit" + vbCrLf)
      WaitFor "221", "quit"
      Sleep 2
       
      frmAction.Winsock1.Close
      Sleep 100
       
    Next
    SendEmail = 1
  Else
    SendEmail = -1
    frmAction.Winsock1.Close
  End If

  Exit Function

SMTPBusy:

  frmAction.NTService.LogEvent svcMessageError, svcEventError, _
     "[" & Err.Number & "] " & Err.Description & "; Source:" & Err.Source
  frmAction.Winsock1.Close
  SendEmail = -1
   
End Function

Sub WaitFor(ResponseCode As String, Optional ByVal MessageSent As String)
  
  Start = Timer ' Time event so won't get stuck in loop
   
  While Len(Response) = 0
    Tmr = Timer - Start
    DoEvents ' Let System keep checking for incoming response **IMPORTANT**

    Sleep 5
    DoEvents

    If Tmr > 100 Then ' Time in seconds to wait
      Err.Raise "-1", "SMTP", _
         "Timeout expired while waiting for " & ResponseCode & _
         " responce from SMTP Server. No Response.. Sent Data= " & MessageSent
      Exit Sub
    End If
  Wend

  While Left(Response, 3) <> ResponseCode
    Tmr = Timer - Start
    DoEvents
    
    Sleep 5
    DoEvents
    
    If Tmr > 100 Then
      Err.Raise "-1", "SMTP", _
        "Timeout expired while waiting for " & ResponseCode & _
        " response from SMTP Server. Wrong Response= " & _
        Response & ".. Sent Data= " & MessageSent
      Exit Sub
    End If
  Wend

  Response = "" ' Sent response code to blank **IMPORTANT**

End Sub

[Advertisement] BuildMaster allows you to create a self-service release management platform that allows different teams to manage their applications. Explore how!