Envío de correos en Excel

Prueba con lo siguiente, entre estas líneas de código:

Email. Send
Next x

Escribe esta línea: Set Email = Nothing, te dbe quedar así

Email. Send

Set Email = Nothing

Next x

Saludos. Dante Amor
Si es lo que necesitas.

No funciona, esa linea ya esta un poco mas abajo para destruir el objeto.

parte del código puesto antes

'antes de enviar actualizamos los datos:
Email.Configuration.Fields.Update
'enviamos el mail
Email.Send
Next x
'destruyo el objeto, para liberar los recursos del sistema
If Not Email Is Nothing Then
Set Email = Nothing
End If
'libero posibles errores
On Error GoTo 0
MsgBox "Envíos finalizados", vbInformation
End Sub

si quieres te envío el libro

Si, ya vi que tienes la línea para "vaciar" el objeto, pero el objeto se va llenado cada vez que regresa al ciclo, por eso, después de enviar un correo hay que "vaciar" el objeto para que en el siguiente ciclo solamente tome el nuevo archivo.

al poner esa linea se para en

Email.To = Cells(x, 2)

Ah, pasa esta línea, al principio de tu macro

For x = 5 To UltFila

Todo debe estar dentro del ciclo, ya que destruyes el objeto, pero en el siguiente ciclo lo tienes que volver a crear.

esa linea ya esta, justamente antes de

Email.To = Cells(x, 2)

Te debe quedar así

Sub EnviarVariosMails_CDO()
'llamo a la función creada (que me conecta al servidor). si devuelve
'false es por que se generaron problemas: aviso y cierro todo
'almaceno la ultima fila ocupada de la tabla
UltFila = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For x = 5 To UltFila
    If AbrirConexion = False Then
    MsgBox "Se presentaron problemas en la conexion", vbCritical
    Set Email = Nothing
    End
    End If
    'llamo a la función para controlar los registros, pasando
 'como argumento la ultima fila ocupada de la tabla:
    res = RevisarTabla(UltFila)
    'si retorna un valor distinto de "ok" es por que algún
    'tipo de error encontró:
    If res <> "ok" Then
        MsgBox res, vbCritical, "Macro cancelada"
        'destruyo el objeto y me voy:
        Set Email = Nothing
        Exit Sub
    End If
    'Dirección del remitente (nosotros)
    Email.From = Trim([b1].Value)
    'y comienzo el recorrido de la tabla, tomando los datos
 'allí existentes y enviando los mails:
    'Dirección del Destinatario
    Email.To = Cells(x, 2)
    'asunto:
    Email.Subject = Cells(x, 3)
    'cuerpo
    Email.TextBody = Cells(x, 4)
    'adjunto:
    If Cells(x, 5) <> "" Then
        Email.AddAttachment Cells(x, 5)
    End If
    'antes de enviar actualizamos los datos:
    Email.Configuration.Fields.Update
    'enviamos el mail
    Email.Send
    Set Email = Nothing
Next x
'destruyo el objeto, para liberar los recursos del sistema
If Not Email Is Nothing Then
Set Email = Nothing
End If
'libero posibles errores
On Error GoTo 0
MsgBox "Envios finalizados", vbInformation
End Sub

Acabo de probarlo he cambiado todo el párrafo completo, ahora al ejecutarla sale directamente envío finalizado pero no hace nada. Antes tardaba un ratito y enviaba los email pero con el problema que te comento.

Gracias por tu yiempo.

Me puedes enviar tu archivo con la macro original, porque ya probé tu macro original y no funciona, ni siquiera para enviar un correo.

Saludos. Dante Amor

mejor te paso el enlace de donde la saque

http://damianexcel.blogspot.com.es/2012/06/macros-como-enviar-mails-desde-excel.html

Ahora sí, lo que pasa es que en tu macro original omitiste las variables globales.

Esta es la macro completa, ya la probé y envía en los correos un solo archivo.

Dim Email As CDO.Message
Dim Autentificion As Boolean
Dim UltFila, X As Long
Sub EnviarVariosMails_CDO()
'almaceno la ultima fila ocupada de la tabla
UltFila = Cells(Cells.Rows.Count, 1).End(xlUp).Row
'llamo a la función para controlar los registros, pasando
'como argumento la ultima fila ocupada de la tabla:
res = RevisarTabla(UltFila)
'si retorna un valor distinto de "ok" es por que algún
'tipo de error encontró:
If res <> "ok" Then
    MsgBox res, vbCritical, "Macro cancelada"
    'destruyo el objeto y me voy:
    Set Email = Nothing
    Exit Sub
End If
'y comienzo el recorrido de la tabla, tomando los datos
'allí existentes y enviando los mails:
For X = 5 To UltFila
    'llamo a la función creada (que me conecta al servidor). Si devuelve
 'false es por que se generaron problemas: aviso y cierro todo
    If AbrirConexion = False Then
        MsgBox "Se presentaron problemas en la conexion", vbCritical
        Set Email = Nothing
        End
    End If
    'Dirección del remitente (nosotros)
    Email.From = Trim([b1].Value)
    'Dirección del Destinatario
    Email.To = Cells(X, 2)
    'asunto:
    Email.Subject = Cells(X, 3)
    'cuerpo
    Email.TextBody = Cells(X, 4)
    'adjunto:
    If Cells(X, 5) <> "" Then
    Email.AddAttachment Cells(X, 5)
    End If
    'antes de enviar actualizamos los datos:
    Email.Configuration.Fields.Update
    'enviamos el mail
    Email.Send
    Set Email = Nothing
Next X
'destruyo el objeto, para liberar los recursos del sistema
If Not Email Is Nothing Then
Set Email = Nothing
End If
'libero posibles errores
On Error GoTo 0
MsgBox "Envios finalizados", vbInformation
End Sub
Function RevisarTabla(ByVal Fin As Long) As String
'recorro todos los registros de la tabla, revisando:
'que haya una direccion de mail
'que detallemos un asunto
'que el cuerpo del mail esté redactado
'que si hay un archivo anexo, el mismo exista:
For X = 5 To Fin
    If InStr(1, Cells(X, 2), "@") = 0 Then
        RevisarTabla = "Error en dirección de mail"
        Cells(X, 2).Select
        Exit Function
    ElseIf Trim(Cells(X, 3)) = "" Then
        RevisarTabla = "Falta el asunto"
        Cells(X, 3).Select
        Exit Function
    ElseIf Trim(Cells(X, 4)) = "" Then
        RevisarTabla = "Falta el mensaje"
        Cells(X, 4).Select
        Exit Function
    ElseIf Trim(Cells(X, 5)) <> "" Then
        If Dir(Trim(Cells(X, 5))) = "" Then
            RevisarTabla = "El adjunto no existe"
            Cells(X, 5).Select
            Exit Function
        Else
            RevisarTabla = "ok"
        End If
    Else
        'si no se detectaron errores, la función
        'retorna "ok"
        RevisarTabla = "ok"
    End If
Next X
End Function
Function AbrirConexion() As Boolean
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") = "[email protected]"
'contraseña
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxx"
'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

Saludos. Dante Amor
No olvides finalizar la pregunta.

si en vez de enviar un solo archivo quisiera adjuntar 3 o 4 podría ser?

como quedaría?

en cuanto tenga un ratito pruebo esta y te cuento. Muchas gracias.