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