Mandar archivo desde Excel con Yahoo

H   o  l a:

Pon tus datos en una hoja empezando en la fila 2.

En la columna B el correo destino

En la columna C el asunto

En la columna D el cuerpo del correo

En la columna E el archivo con ruta y extensión, ejemplo: C:\trabajo\archivo.txt

Cambia en la función tu usuario de correo y el password

    correo = "[email protected]"
    Password = "laclave"

Ejecuta la macro EnviarVariosMails_CDO

Pon todo el siguiente código en un módulo:

Dim Email As CDO.Message
Function AbrirConexion() As Boolean
    correo = "[email protected]"
    Password = "laclave"
    'AbrirConexion = False
    'ahora doy vida al objeto
    Set Email = New CDO.Message
    'indicamos los datos del servidor:
    Email.Configuration.Fields(cdoSMTPServer) = "smtp.mail.yahoo.com"
    Email.Configuration.Fields(cdoSendUsingMethod) = 2
    'indicamos el nro de puerto. por defecto es el 25, pero gmail usa el 465. hay otro
    '(que ahora no recuerdo) pero no me funcionaba... por eso no lo usé mas y lo olvidé
    Email.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
    'aqui dejamos en claro si el servidor que usamos requiere o nó autentificación.
    '1=requiere, 0=no requiere. Para gmail, entonces, 1
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" _
    & "configuration/smtpauthenticate") = Abs(1)
    'segundos para el tiempo maximo de espera. aconsejo no modificarlo:
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
    'aqui defino como True (verdadera) a la autentificación para el envío de mails.
    Autentificacion = True
    'ahora configuramos las opciones de login de gmail:
    If Autentificacion Then
    'nombre de usuario
    Email.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
    'contraseña
    Email.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password
    'si el servidor utiliza SSL (secure socket layer). en gmail: True
    Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    AbrirConexion = True
    Else
    AbrirConexion = False
    End If
End Function
'
Sub EnviarVariosMails_CDO()
    Dim conectar As Boolean
    'almaceno la ultima fila ocupada de la tabla
    UltFila = Cells(Cells.Rows.Count, "B").End(xlUp).Row
    'llamo a la función creada (que me conecta al servidor). si devuelve
    'false es por que se generaron problemas: aviso y cierro todo
    For i = 2 To UltFila
        conectar = AbrirConexion()
        If conectar = False Then
            MsgBox "Se presentaron problemas en la conexion", vbCritical
            Set Email = Nothing
            End
        End If
        DoEvents
        Email.From = "[email protected]"
        Email.To = Cells(i, "B").Value
        Email.Subject = Cells(i, "C").Value
        Email.TextBody = Cells(i, "D").Value
        'adjunto:
        If Cells(i, "E").Value <> "" Then
            If Dir(Cells(i, "E").Value) <> "" Then
                Email.AddAttachment Cells(i, "E").Value
            End If
        End If
        'antes de enviar actualizamos los datos:
        Email.Configuration.Fields.Update
        'enviamos el mail
        On Error Resume Next
        Email.Send
    Next
    'destruyo el objeto, para liberar los recursos del sistema
    If Not Email Is Nothing Then
        Set Email = Nothing
    End If
    MsgBox "Envios finalizados", vbInformation
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.