Private Sub cmdSend_Click()
Subject = 'the subject here
'FILL UP OUR EMAIL STRUCTURE
With Myemail
.From = 'the from email address here
.Subject = Subject
.To = myemailaddress
.Msg = 'The Main body of message here
End With
'NOW WE SEND IT
cmdSend.Enabled = False
lblStatus.Caption = "Connecting..."
Winsock1.Connect Myemail.SMTP, "25" 'Connect to server
End Sub
Private Sub Form_Load()
myappname = 'the application name here
myemailaddress = 'The Email address to send to here
With Myemail
.Format = "plain;"
.SMTP = "mail.hotmail.com" ' you might want to find a different server, this is the only one i can find, but it can only send to hotmail addresses.
End With
End Sub
Private Sub Winsock1_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)
If Not Number = sckSuccess Then
MsgBox Description 'Display error
Timer1.Enabled = False
CloseConn True
End If
End Sub
Private Sub Winsock1_DataArrival _
(ByVal bytesTotal As Long)
Dim data As String
Winsock1.GetData data, vbString
'Add data arrived data to the already arrived data
inData = inData + data
'Wait till a line is recieved (with CR LF in the end)
If StrComp(Right$(inData, 2), vbCrLf) = 0 Then DataAvailable = True
End Sub
Private Sub Winsock1_Connect()
lblStatus.Caption = "Connected"
timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
Dim reply As String
Dim tmp() As String
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 220 Then 'Error occured
MsgBox "Server returned the following error:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
lblStatus.Caption = "Receiving Welcome Message"
'Start the process
Winsock1.SendData "HELO " + Winsock1.LocalHostName + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then
MsgBox "Server returned the following error:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
'Send MAIL FROM
Winsock1.SendData "MAIL FROM:<" + Myemail.From + ">" + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then
MsgBox "Server returned the following error:" + vbCrLf + reply
CloseConn True
Exit Sub
End If
'Send RCPT TO
Winsock1.SendData "RCPT TO:<" + Myemail.To + ">" + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then
MsgBox "Server returned the following error:" + vbCrLf + reply
CloseConn True
Exit Sub
End If
'Send DATA
DoEvents
Winsock1.SendData "DATA" + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 354 Then
MsgBox "Server returned the following error:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
lblStatus.Caption = "Sending Mail . . ."
'Send the E-Mail
Winsock1.SendData "From: <" + Myemail.From + ">" + vbCrLf + _
"To: " + Myemail.To + vbCrLf + _
"Subject: " + Myemail.Subject + vbCrLf + _
"X-Mailer: Gmcd'sBugReport V1" + vbCrLf + _
"Mime-Version: 1.0" + vbCrLf + _
"Content-Type: text/" + Myemail.Format + vbTab + "charset=us-ascii" + vbCrLf + vbCrLf + _
txtMessage.Text
Winsock1.SendData vbCrLf + "." + vbCrLf
DoEvents
timer = 0
Timer1.Enabled = True
While Not DataAvailable 'Wait for reply
If Winsock1.State = sckClosed Then Exit Sub
DoEvents
Wend
Timer1.Enabled = False
reply = inData
inData = ""
DataAvailable = False
tmp = Split(reply, " ")
If Not Val(tmp(0)) = 250 Then 'Error occured
MsgBox "Server returned the following error:" + vbCrLf + reply
CloseConn False
Exit Sub
End If
Winsock1.SendData "QUIT"
MsgBox "Report Sent Successfully", vbInformation, "Done"
CloseConn False
End Sub
Private Sub Timer1_Timer()
timer = timer + 1
If timer = TIME_OUT Then
CloseConn True 'Disconnect if timed out
MsgBox "Could not connect to host " + Myemail.SMTP + vbCrLf + "Operation timed out"
Timer1.Enabled = False
End If
End Sub
Private Sub CloseConn(Err As Boolean)
'Close Connection & enable contrls
Winsock1.Close
lblStatus.Caption = "Send"
cmdSend.Enabled = True
End Sub