also on the winsock smtp emailer

[wengang]

another problem is that using winsock to send the email,
it only works if I pick an email address that is on my domain.

when I pick an email address like [email protected]
it throws out error 550, saying that it doesn't recognize that user.

Any ideas?

[jmsrickland]

another problem is that using winsock to send the email,
it only works if I pick an email address that is on my domain.

when I pick an email address like [email protected]
it throws out error 550, saying that it doesn't recognize that user.

Any ideas?

Are you using Winsock for a client or server? Then it depends on how you are setting up ypur application and what SMTP commands you're using.

[wengang]

Honestly, I haven't tried to email programattically before.
I find it a bit confusing.

I have a website, say ggg.com and an email there, say [email protected]
I have a code that I can use to send messages from [email protected] to [email protected], but when I get the email in Outlook, the body of the message is not there, only the subject in the subject line.
Also, I can't send an email to anybody I want, only to myself.
The code is stuff I've pieced together from all the samples I'm finding here (pieced together because I can't seem to get a single piece of code to work without altering it).

I'll post the code below:

Option Explicit
 
Private WithEvents SMTP As clsSMTP
 
Private Sub Command1_Click()
Dim Winsock1 As New Winsock
 
With SMTP
 'who is the email from?
 .Sender = "[email protected]"
 'who is it going to?
 .Recipient = "[email protected]"
 'your SMTP server
 .SMTPhost = "mail.ggg.com"
 'optional subject line
 .Subject = "SMTP test"
 'make connection to the server
 
 .OpenMail Winsock1
 'did connection succeed?
 If Not .Connected Then Exit Sub
 'you can send as many lines as you want here
.Send "This is a test of your wonderful SMTP client!"
 'make sure you close or nothing will get sent
 .CloseMail
End With
MsgBox ("Success")
 
End Sub
 
 
 
Private Sub Form_Load()
    Set SMTP = New clsSMTP
End Sub

SMTP is a class and it's code is below:

Option Explicit
 
Private mvarConnected As Boolean
Private mvarRecipient As String
Private mvarSender As String
Private mvarSMTPhost As String
Private mvarSubject As String
 
'Private WithEvents Winsock As MSWinsockLib.Winsock
 
Private WithEvents mvarWinsock As Winsock
 
Const OK = 250
Const Connection = 220
Const ReadyforData = 354
Const UserUnknown = 550
 
Dim Reply As Integer
Dim Message As String
Dim MyName As String
Dim ErrMSg As String
 
Event Error(Code As Integer, Message As String)
Event ServerResponse(Reply As Integer, Message As String)
 
Private Function WaitFor(R As Integer) As Boolean
Dim A
    A = Timer + 30
    While Not Reply = R And A > Timer
    DoEvents
    Wend
    If A < Timer Then
        WaitFor = True
    Else
        WaitFor = False
    End If
    Reply = 0
End Function
 
Public Property Let Subject(ByVal vData As String)
    mvarSubject = vData
End Property
 
Public Property Get Subject() As String
    Subject = mvarSubject
End Property
 
Public Property Let SMTPhost(ByVal vData As String)
    mvarSMTPhost = vData
End Property
 
Public Property Get SMTPhost() As String
    SMTPhost = mvarSMTPhost
End Property
 
Public Sub Send(Message As String)
 mvarWinsock.SendData Message & vbCrLf
End Sub
 
Public Property Let Sender(ByVal vData As String)
    mvarSender = vData
End Property
 
Public Property Get Sender() As String
    Sender = mvarSender
End Property
 
Public Property Let Recipient(ByVal vData As String)
    mvarRecipient = vData
End Property
 
Public Property Get Recipient() As String
    Recipient = mvarRecipient
End Property
 
Public Property Get Connected() As Boolean
    Connected = mvarConnected
End Property
 
Public Sub OpenMail(myWinsock As Winsock)
    
    Set mvarWinsock = myWinsock
    
    Reply = 0
    'connect to SMTP server
    mvarWinsock.Connect mvarSMTPhost, 25
    If WaitFor(Connection) Then
        GiveError
        Exit Sub
    End If
    'send hello and wait for OK
    mvarWinsock.SendData "helo " & mvarSMTPhost & vbCrLf
    If WaitFor(OK) Then
        GiveError
        mvarWinsock.Close
        Exit Sub
    End If
    'send sender's name
     If InStr(mvarSender, "@") = 0 Then
        mvarWinsock.SendData "Mail From:<" & mvarSender & "@" & MyName & ">" & vbCrLf
    Else
        mvarWinsock.SendData "Mail From:<" & mvarSender & ">" & vbCrLf
    End If
    If WaitFor(OK) Then
        GiveError
        mvarWinsock.Close
        Exit Sub
    End If
    'send recipient
    mvarWinsock.SendData "RCPT TO:<" & mvarRecipient & ">" & vbCrLf
    If WaitFor(OK) Then
        GiveError
        mvarWinsock.Close
        Exit Sub
    End If
    'make ready for data
    mvarWinsock.SendData "Data" & vbCrLf
    If WaitFor(ReadyforData) Then
        GiveError
        mvarWinsock.Close
        Exit Sub
    End If
    'Send Date:
    mvarWinsock.SendData "Date: " & Format(Date, " dd mmm yy ") & Time & vbCrLf
    'To:
    mvarWinsock.SendData "TO:<" & mvarRecipient & ">" & vbCrLf
    'From:
    mvarWinsock.SendData "From: <" & mvarSender & ">" & vbCrLf
    'Subject:
    If Not mvarSubject = "" Then mvarWinsock.SendData "Subject:" & mvarSubject & vbCrLf
    'Body
    mvarWinsock.SendData "Body: THis is a test." & vbCrLf
    mvarWinsock.SendData "This is a a test email." & vbCrLf
    mvarConnected = True
End Sub
 
Private Function WhoAmI() As String
Dim X As Integer, Y As Integer, Z As Integer
 
    X = InStr(Message, "Hello")
    Y = InStr(Message, "[")
    Z = InStr(Message, "]")
    
    'MsgBox (X & " " & Y)
    
    If X = 0 Or Y = 0 Or Z = 0 Then
        WhoAmI = mvarWinsock.LocalIP
    Else
        X = X + 7
        'Y = Y - 1 - X
        Z = Z - X
        WhoAmI = Mid$(Message, X, Z)
        'WhoAmI = Mid$(Message, X, Y)
    End If
End Function
 
Public Sub CloseMail()
    mvarWinsock.SendData "." & vbCrLf
    If WaitFor(OK) Then
        GiveError
        Exit Sub
    End If
    mvarWinsock.SendData "QUIT"
    mvarWinsock.Close
End Sub
 
Private Sub GiveError()
 Dim Message As String
 Select Case Reply
 Case Is = 10061
  Message = "Can't Connect to " & mvarSMTPhost
 Case Is = 11001
  Message = mvarSMTPhost & " is not a valid name or address."
 Case Is = 550
  Message = "User " & mvarRecipient & " not known to server."
 Case Is = 0
  Message = "Timeout waiting for server response"
 Case Is = 500
  Message = "Server does not recognize a command sent."
 Case Is = 553
  Message = "Invalid recipient name"
 Case Is = 1
  Message = "You must set Host, Recipient and Sender before connecting"
 Case Else
  Message = "Mail tool error."
 End Select
 
 RaiseEvent Error(Reply, Message)
End Sub
 
Private Sub Class_Initialize()
    'Set mvarWinsock = New Winsock
End Sub
 
Private Sub mvarWinsock_DataArrival(ByVal bytesTotal As Long)
Dim X As String
    mvarWinsock.GetData X
    Reply = Val(X)
    X = Trim$(Mid(X, 4))
    RaiseEvent ServerResponse(Reply, X)
    Message = X
End Sub
 
Private Sub mvarWinsock_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)
    Reply = Number
End Sub

I've tried to include the email body both in the sub and in the class itself, but it just doesn't show up.
Then of course the more serious issue of only being able to email myself so far.

[jmsrickland]

Try this little SMTP application and see what it does for you. If the mail recipient requires Authentication then this will not do you any good as you will need to know what it is and how to use it.

[Doogle]

I suspect the problem of no body being received is to do with this and the version of Outlook you're using:

   mvarWinsock.SendData "Body: THis is a test." & vbCrLf

Try

   mvarWinsock.SendData "THis is a test." & vbCrLf

or even this.

   mvarWinsock.SendData "Body:" & vbCrLf
   mvarWinsock.SendData " THis is a test." & vbCrLf

I assume that "Body:" is something that Outlook can expect as I don't see it defined anywhere in the SMTP Protocol.

BTW: Why have you modified the Class code ? It works perfectly 'as is'