Private Sub smtp_DataArrival(ByVal bytesTotal As Long)
Dim strServerResponse As String
Dim strResponseCode As String
Dim strDataToSend As String
smtp.GetData strServerResponse
Debug.Print strServerResponse
strResponseCode = Left(strServerResponse, 3)
List1.Clear
If strResponseCode = "250" Or _
strResponseCode = "220" Or _
strResponseCode = "354" Then
Select Case smtpState
Case MAIL_CONNECT
smtpState = MAIL_HELO
strDataToSend = Trim$(txtSender.Text)
strDataToSend = Left$(strDataToSend, _
InStr(1, strDataToSend, "@") - 1)
smtp.SendData "HELO " & strDataToSend & vbCrLf
Debug.Print "HELO " & strDataToSend
Case MAIL_HELO
smtpState = MAIL_FROM
smtp.SendData "MAIL FROM:" & Trim$(txtSender.Text) & vbCrLf
List1.AddItem "MAIL FROM:" & Trim$(txtSender.Text)
Debug.Print "MAIL FROM:" & Trim$(txtSender.Text)
Case MAIL_FROM
smtpState = MAIL_RCPTTO
smtp.SendData "RCPT TO:" & Trim$(txtRecipient.Text) & vbCrLf
List1.AddItem "RCPT TO:" & Trim$(txtRecipient.Text)
Debug.Print "RCPT TO:" & Trim$(txtRecipient.Text)
Case MAIL_RCPTTO
smtpState = MAIL_DATA
smtp.SendData "DATA" & vbCrLf
List1.AddItem "DATA"
Debug.Print "DATA"
Case MAIL_DATA
smtpState = MAIL_DOT
smtp.SendData "Subject:" & txtSubject.Text & vbLf & vbCrLf
List1.AddItem "Subject:" & txtSubject.Text
Debug.Print "Subject:" & txtSubject.Text
Dim varLines As Variant
Dim varLine As Variant
Dim strMessage As String
strMessage = txtMessage.Text & vbCrLf & vbCrLf & EncodedFile
EncodedFiles = ""
varLines = Split(strMessage, vbCrLf)
strMessage = ""
For Each varLine In varLines
smtp.SendData CStr(varLine) & vbLf
List1.AddItem varLine
Next
smtp.SendData "." & vbCrLf
List1.AddItem "."
Debug.Print "."
Case MAIL_DOT
smtpState = MAIL_QUIT
smtp.SendData "QUIT" & vbCrLf
Debug.Print "QUIT"
Case MAIL_QUIT
smtp.Close
End Select
Else
smtp.Close
If Not smtpState = MAIL_QUIT Then
MsgBox "Error: " & strServerResponse, vbCritical, "Error"
Unload Me
Else
'Unload Me
List1.AddItem "Message sent"
Debug.Print "Message sent"
MsgBox "Message has been sent"
End If
End If
End Sub
Rispondi quotando