Macro envió de correos masiva

Te anexo la macro para enviar correos masivos

Sub Enviar_Correos()
'---
'   Por.Dante Amor
'---
    '***Macro Para enviar correos
    col = Range("H1").Column
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Set dam = CreateObject("Outlook.Application").CreateItem(0)
        '
        dam.To = Range("B" & i).Value           'Destinatarios
        dam.Cc = Range("C" & i).Value           'Con copia
        dam.Bcc = Range("D" & i).Value          'Con copia oculta
        dam.Subject = Range("E" & i).Value      '"Asunto"
        dam.Body = Range("F" & i).Value         '"Cuerpo del mensaje"
        '
        For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
            archivo = Cells(i, j).Value
            If archivo <> "" Then dam.Attachments.Add archivo
        Next
        Dam. Send 'El correo se envía en automático
 'dam. Display 'El correo se muestra
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Estimado Dante,

En el caso de que el correo de destino (el mio) sea gmail, no debiese haber algunas líneas de código donde me pida ingresar mis datos (Correo y contraseña)

Utiliza la siguiente macro para enviar por Gmail.

Pon tu correo y password en estas líneas:

    correo = "[email protected]"                 'correo gmail
    passwd = "pwd"                              'tu password

La macro:

Sub Enviar_Correos_Gmail()
'---
'   Por.Dante Amor
'---
    '***Macro Para enviar correos por Gmail
    correo = "[email protected]"                 'correo gmail
    passwd = "pwd"                              'tu password
    '
    col = Range("H1").Column
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        ruta = ThisWorkbook.Path & "\"
        '
        Dim Email As CDO.Message
        Set Email = New CDO.Message
        Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
        Email.Configuration.Fields(cdoSendUsingMethod) = 2
        With Email.Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
            .Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        End With
        With Email
            .To = Range("B" & i).Value           'Destinatarios
            .From = correo
            .Subject = Range("E" & i).Value      '"Asunto"
            .TextBody = Range("F" & i).Value     '"Cuerpo del mensaje"
            archivo = Range("H" & i).Value       'archivo
            If archivo <> "" Then
                If Dir(archivo) <> "" Then
                    .AddAttachment archivo
                End If
            End If
            .Configuration.Fields.Update
            On Error Resume Next
            .Send
        End With
'        If Err.Number = 0 Then
'            MsgBox "El mail se envió con éxito"
'        Else
'            MsgBox "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
'        End If
        Set Email = Nothing
    Next
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Estimado Dante,

Al ejecutar la macro me sale el siguiente error (Entiendo que tal vez hay complementos no activados), me gustaría poder conversar contigo en vivo, no se si dispones de tiempo para charlar vía skype y así explicarte lo que necesito y los errores que me van apareciendo.

Adjunto pantalla del error:

Entra al menú de VBA, Herramientas, Referencias, busca la referencia : Microsoft CDO for windows 2000 library", la marcas y presiona Aceptar.

En tu cuenta de gmail deberás activar el "Acceso de aplicaciones menos seguras"

https://www.google.com/settings/security/lesssecureapps 

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

Estimado Dante,

Esta funcionado, envía el correo y todo. Sin embargo, necesito que el siguiente mensaje vaya cambiando de destinatario:

Estimado "XXXXXXX"
Somos alumnos de la carrera de Ingeniería Comercial de la Universidad Tecnológica Metropolitana, UTEM. Nos encontramos en el proceso de realizar nuestro Proyecto de Título para el cual estamos desarrollando una investigación de mercado que tiene relación con la actividad que usted realiza.

Por ejemplo si tengo 8 destinatarios: Jose, Pablo, Nicolas, Dante, etc... vaya variano a

Estimado Jose,

Estimado Pablo

Entiendo que se puede con la función "i", ¿me podrías ayudar con esto?

Adicional a esto, en la línea del código donde dice "FROM" y pone correo, cuando llegan los correos no llegan con mi nombre (Hector Valderrama) sino que llegan con la dirección de Correo, ¿hay alguna forma de arreglar eso?

Solamente pon 8 filas en mi aplicación, en la celda

A2 pones a Jose,

En la D2 pones

Somos alumnos de la carrera de Ingeniería Comercial de la Universidad Tecnológica Metropolitana, UTEM. Nos encontramos en el proceso de realizar nuestro Proyecto de Título para el cual estamos desarrollando una investigación de mercado que tiene relación con la actividad que usted realiza.

En la celda E2 pon la siguiente fórmula

="Estimado "&A2& " " &D2

Entonces en A3 pones a Pablo

En D3 pones el mismo texto

En E3 pones la fórmula

="Estimado "&A3& " " &D3

Y así te sigues con todos los destinatarios.

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