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

337 - Enviar correo con Microsoft CDO

Contenido:

Ejemplo 1
Ejemplo 2
Enlaces relacionados

Ejemplo 1

Código fuente de ejemplo , que muestra como enviar email desde visual basic utilizando la referencia a Microsoft CDO for windows 2000 library.

Como dice el títiulo, este componente activex solo se puede utilizar en versiones de windows 2000 en adelante ( desconozco si funciona bien en windows vista )

El ejemplo que se muestra a continuación, muestra como enviar un correo, mediante un servidor SMTP que requiere autentificación, es decir que se debe especificar : el servidor SMTP, el Id de usuario, la contraseña entre otras cosas

Vista del formulario

vista previa del formulario de ejemplo para enviar el correo electrónico

Nota: yo intenté usar este mismo ejemplo mediante una cuenta de yahoo pero me dió error.

Con Gmail funciona perfecto.

Para poder usar el servidor SMTP de Gmail, se debe tener en cuenta los siguientes datos al momento de configurar el componente Microsoft CDO

El nombre del servidor debe ser : smtp.gmail.com
El puerto que dispone google para dichos servidores es el 465 o el 587. A mi este ultimo me dió error
El nombre de usuario para la autentificación, debe ser el nombre de la cuenta de correo de gmail, incluyendo el @gmail.com .
El password es la misma contraseña de logueo para la cuenta de Gmail
Una cosa importante, es que como Gmail utiliza SSL para el correo, debemos indicar en el código que se utilizará SSL, si no no funcionará

Para usar el la referencia primero se debe agregar el componente Activex Microsoft CDO desde el menú referencias:

vista de la ventana para agregar la referencia a Microsoft CDO

Si se quiere hacer mediante automatización, para no incluir la referencia se debe crear el objeto con CreateObject

Dim Obj As Object

Set Obj = CreateObject("CDO.Message")

Controles para el formulario

Añadir los siguietnes controles como muestra el gráfico que está al comienzo de la página

Controles del primer Frame " datos remotos "

Un control Textbox para indicar el servidor SMTP ( puede ser la dirección ip o el nombre del servidor de mail ) : txt_Servidor
Un textbox para el puerto ( si no se indica el puerto se usa por defecto el 25 ) : txt_Puerto
Un text para el id de usuario de la cuenta : txt_Usuario
Un text para el password : txt_Password

Controles para el Frame " datos del mensaje "

Un textbox para el nombre del remitente : txt_De
textbox para el destinatario : txt_Para
Textbox para el texto del asunto : txt_Asunto
Testbox para el archivo adjunto : txt_Adjunto
textbox para el texto del mensaje : txt_Mensaje
Un CommandButton para enviar el mail : Command1

Código fuente en el formulario

Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' El ejemplo para poder enviar el mail necesita la referencia a: _ > Miscrosoft CDO Windows For 2000 Library ( es el archivo dll cdosys.dll ) '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Function Enviar_Mail_CDO(SerVidor_SMTP As String, _ Para As String, _ De As String, _ Asunto As String, _ Mensaje As String, _ Optional Path_Adjunto As String, _ Optional Puerto As String = "25", _ Optional Usuario As String, _ Optional Password As String, _ Optional Usar_Autentificacion As Boolean = True, _ Optional Usar_SSL As Boolean = True) As Boolean Me.MousePointer = vbHourglass ' Variable de objeto Cdo.Message Dim Obj_Email As CDO.Message ' Crea un Nuevo objeto CDO.Message Set Obj_Email = New CDO.Message ' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _ del servidor o su dirección IP ) Obj_Email.Configuration.Fields(cdoSMTPServer) = SerVidor_SMTP Obj_Email.Configuration.Fields(cdoSendUsingMethod) = 2 ' Puerto. Por defecto se usa el puerto 25, en el caso de Gmail se usan los puertos _ 465 o el puerto 587 ( este último me dio error ) Obj_Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(Puerto) ' Indica el tipo de autentificación con el servidor de correo _ El valor 0 no requiere autentificarse, el valor 1 es con autentificación Obj_Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _ "configuration/smtpauthenticate") = Abs(Usar_Autentificacion) ' Tiempo máximo de espera en segundos para la conexión Obj_Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 ' Configura las opciones para el login en el SMTP If Usar_Autentificacion Then ' Id de usuario del servidor Smtp ( en el caso de gmail, debe ser la dirección de correro _ mas el @gmail.com ) Obj_Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usuario ' Password de la cuenta Obj_Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password ' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True Obj_Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Usar_SSL End If ' ********************************************************************************* ' Estructura del mail '********************************************************************************** ' Dirección del Destinatario Obj_Email.To = Para ' Dirección del remitente Obj_Email.From = De ' Asunto del mensaje Obj_Email.Subject = Asunto ' Cuerpo del mensaje Obj_Email.TextBody = Mensaje 'Ruta del archivo adjunto If Path_Adjunto <> vbNullString Then Obj_Email.AddAttachment (Path_Adjunto) End If ' Actualiza los datos antes de enviar Obj_Email.Configuration.Fields.Update On Error Resume Next ' Envía el email Obj_Email.Send If Err.Number = 0 Then Enviar_Mail_CDO = True Else MsgBox Err.Description, vbCritical, " Error al enviar el amil " End If ' Descarga la referencia If Not Obj_Email Is Nothing Then Set Obj_Email = Nothing End If On Error GoTo 0 Me.MousePointer = vbNormal End Function Private Sub Command1_Click() Dim ret As Boolean ' Asegurarse de pasar bien los últimos dos parámetros _ ( Si usa login y si el server usa SSL) ret = Enviar_Mail_CDO(txt_Servidor, _ txt_Para, _ txt_De, _ txt_Asunto, _ txt_Mensaje, _ txt_Adjunto, _ txt_Puerto, _ txt_Usuario, _ txt_Password, _ True, _ True) ' Si devuelve true es por que no hubo errores en el envio If ret Then MsgBox " .. Maneje enviado ", vbInformation End If End Sub Private Sub Form_Load() Me.Caption = " Ejemplo para enviar correo usando la libreria Microsoft CDO " Command1.Caption = " Enviar mail " txt_Servidor.Text = "smtp.gmail.com" txt_Para = "destinatario@dominio.com" txt_De = "remitente@dominio.com" txt_Asunto = "Prueba" txt_Mensaje = " ... Cuerpo del mensaje " txt_Adjunto = vbNullString txt_Puerto.Text = 465 txt_Password = "" txt_Usuario = "" End Sub

Nota: En los últimos dos parámetros de la función EnviarEmail, se indica si el servidor requiere autentificación ( parámetro Usar_Autentificacion por defecto es True) y el otro Usar_SSL ( por defecto es True).

Si estos datos del servidor SMTP son incorrectos, nos dará error al enviar el mail, por lo tanto averiguar bien los datos del server para ahorrarnos dolores de cabeza ( lo mismo para el puerto que utiliza, ya que algunos no utilizan el puerto por default que es el 25)

Nota sobre archivos adjuntos : si se desea enviar varios archivos en el mismo mensaje , se debe ejecutar el método para cada archivo, por ejemplo :

CDO.AddAttachment (Adjunto 1) CDO.AddAttachment (Adjunto 2) CDO.AddAttachment (Adjunto 3) ... resto de código

Ejemplo 2

En este otro enlace , podés descargar un ejemplo similar usando CDO pero mediante un módulo de clase : Descargar ( para implementarlo mas fácilmente )

Recursos vb 6.0 - Enlaces relacionados

Buscar en Recursos vb