Sección de códigos , trucos y ejemplos para visual basic

340 - Enviar email con el control Winsock

Formulario para poder enviar un correo mediante el control Winsock de vb

Este ejemplo muestra como enviar un mensaje de correo , utilizando un servidor SMTP sin autentificación con el control Microsoft Winsock

El formulario

vista del formulario de ejemplo para envio de correo mediante el Microsoft winsock control 6.0

Nota: Al final de la página , hay otros ejemplos para poder leer y enviar correo con diferentes componentes

Controles para el formulario

txt_Server_Smtp : indica la ip o nombre del Host de correo a utilizar para el envío
txt_nameFrom : Nombre del que envia el mail, en este caso nuestro nombre. este parámetro es opcional
txt_emailFrom : Nuestra dirección de mail
txt_NameTo : Nombre del destinatario . Parámetro opcional
txt_MailTo : Obviamente parámetro obligatorio
txt_Asunto : parámetro opcional . Asunto del mensaje
txt_Mensaje : Para el texto del mensaje . Coloarle la propiedad Multiline en true
ProgressBar : para mostrar l progreso
Dos CommandButton . Para conectar y desconectar
Un control Microsoft Winsock

Código fuente en el formulario

Option Explicit Private m_Sleep As Boolean Private Estado As String ' Rutina que envía el correo mediante el Winsock ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Winsock_mail(Smtp_Server As String, _ Name_From As String, _ Mail_From As String, _ Name_To As String, _ Mail_to As String, _ Asunto_Mensaje As String, _ Mensaje As String) On Error GoTo Err_Sub Estado = vbNullString ProgressBar1.Max = 4 ProgressBar1.Value = 0 With Winsock1 ' cierra el winsock .Close ' conecta al servidor en el puerto 25 .Connect Smtp_Server, "25" ' Bucle mientras conecta al Smtp Do While .State <> sckConnected DoEvents If .State = sckClosed Or .State = sckError Then MsgBox "Error ", vbCritical Desconectar Exit Sub End If Loop ' almcena el texto del estado del envio Estado = Estado & "Conectado a " & Smtp_Server & "." & vbCrLf Do While m_Sleep = False DoEvents Loop ' Envia los datos del remitente .SendData "MAIL FROM: " & Mail_From & vbCrLf ' texto de estado Estado = Estado & "MAIL FROM: " & Mail_From & vbCrLf Do While ProgressBar1.Value <> 1 DoEvents Loop ' Envia los datos del destinatario .SendData "RCPT TO: " & Mail_to & vbCrLf ' texto de estado Estado = Estado & "RCPT TO: " & Mail_to & vbCrLf ' espera Do While ProgressBar1.Value <> 2 DoEvents Loop ' acá se envía el mail .SendData "DATA" & vbCrLf Estado = Estado & "DATA" & vbCrLf Do While ProgressBar1.Value <> 3 DoEvents Loop .SendData "FROM: " & Name_From & " <" & Mail_From & ">" & vbCrLf .SendData "TO: " & Name_To & " <" & Mail_to & ">" & vbCrLf .SendData "SUBJECT: " & Asunto_Mensaje & vbCrLf .SendData vbCrLf .SendData Mensaje & vbCrLf Estado = Estado & Mensaje & vbCrLf .SendData vbCrLf & "." & vbCrLf Estado = Estado & vbCrLf & "." & vbCrLf Do While ProgressBar1.Value <> 4 DoEvents Loop ' Envía el comando de cierre .SendData "QUIT" & vbCrLf ' cierra la conexión del winsock .Close ' muestra el mensaje de estado ( se puede _ mostrar en un textbox multilinea ) MsgBox Estado, vbInformation ProgressBar1.Value = 0 End With Exit Sub Err_Sub: ' Si hay error muestra el mensaje y cierra el socket Winsock1.Close MsgBox Err.Description, vbCritical End Sub Private Sub Desconectar() 'Cierra el Winsock Winsock1.Close End Sub ' Botón que envía el e-mail ''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Command1_Click() Winsock_mail txt_Server_Smtp, _ txt_nameFrom, _ txt_emailFrom, _ txt_NameTo, _ txt_MailTo, _ txt_Asunto, _ txt_Mensaje End Sub ' Botón que Finaliza el socket abierto ''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Command2_Click() Call Desconectar End Sub ' este evento recibe los datos de respuesta del servidor Smtp _ para poder almacenar el texto del estado de la operacion de envío _ y mostrar el progreso en el progressbar '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Dim Data As String 'Datos ' Retorno del Winsock Dim ret As String ' recupera los datos Winsock1.GetData Data ' formatea ret = Mid(Data, 1, 3) Estado = Estado & Data & vbCrLf Select Case ret Case 250 ProgressBar1.Value = ProgressBar1.Value + 1 Case 354 ProgressBar1.Value = ProgressBar1.Value + 1 Case 220 m_Sleep = True End Select End Sub Private Sub Form_Load() Command1.Caption = " Enviar " Command2.Caption = " Desconectar " Me.Caption = "Envío de email con el control Winsock " End Sub

Leer los correos de un Pop3 con el winsock y guardar los mensajes en disco como archivos EML

Este ejemplo se conecta a un Pop3, y obtiene todos los mail y los lista en un ListBox. Luego escribe el contenido del mail y lo guarda como archivo .Eml en el App.path

En el formulario agregar un control Winsock llamado Winsock1. Un control Listbox y un CommandButon

A al procedimiento LeerMail, pasarle como parámetro el nombre del servidor pop3, la cuenta, el password y el puerto

Dim Recibido As Boolean Dim Mensaje As String Dim sckError Private Sub Command1_Click() ' por ejemplo : ' Call Leer("pop3.dominio.com", 110, "cuenta@dominio.com", "password") End Sub ' se reciben los datos '''''''''''''''''''''''''''' Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData Mensaje Select Case Winsock1.Tag Case "RETR" ' escribe en disco el archivo eml Put #1, , Mensaje If InStr(Mensaje, vbLf + "." + vbCrLf) Then Close 1 Recibido = True End If Case Else sckError = (Left$(Mensaje, 3) = "-ER") Recibido = True End Select End Sub Private Sub Winsock1_Close() Winsock1.Close End Sub Private Sub Leer(Pop3 As String, _ Puerto As Integer, _ Cuenta As String, _ Password As String) ' Conecta con el Pop3 Winsock1.Connect Pop3, Puerto Do Until Recibido DoEvents Loop If sckError Then MsgBox "Error al conectar con el servidor Pop3", vbCritical Exit Sub End If ' usuario SendCommand "USER " & Cuenta If sckError Then MsgBox "Error con el nombre de usuario ", vbCritical Exit Sub End If ' Envía el passowrd SendCommand "PASS " & Password If sckError Then MsgBox "Password incorrecto", vbCritical Exit Sub End If ' Get Number of Messages and total size in bytes SendCommand "STAT" x = InStr(Mensaje, " ") b = InStrRev(Mensaje, " ") Messages = Val(Mid$(Mensaje, x + 1, b - x)) ' Recorre la cantidad de mensajes For i = 1 To Messages Winsock1.Tag = "RETR" 'crea un archivo Open App.Path & "\eMail-" & i & ".eml" For Binary Access Write As #1 Call SendCommand("RETR " & i) List1.AddItem "eMail " & i Next Winsock1.Tag = "" End Sub Sub SendCommand(Comando As String) Winsock1.SendData Comando + vbCrLf Recibido = False Do Until Recibido DoEvents Loop End Sub

Recursos vb 6.0 - Enlaces relacionados

Buscar en Recursos vb