Quiero poner el nombre de una celda a un documento adjunto según una condición

[Hola

Si mal no te entendí, esto te ayudará a entender cómo hacer:

https://abrahamexcel.blogspot.com/2018/06/enviar-mensajes-masivos-con-microsoft.html 

Comentas

Abraham Valencia

Hola Abraham buenas tardes, te comento que solo tengo un solo documento para enviar, pero quiero que ese documento se replique para todos los correos que tengo, y tiene que ser personalizado por persona, mira tengo esto: (quiero que lo que esta en negrita sea el nombre del documento adjunto.

Sub Enviar_Correos()

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, "E").Value = "LIDER DE SI MISMO" Then
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Cells(i, "F").Value 'Destinatarios
dam.Subject = "Recordatorio de seguimiento a pendientes"
dam.Body = "Estimado/a : " & Cells(i, "A").Value & vbCr & vbCr & _
"el 18 se comenzo con la evaluacion de desempeño y se estan viendo los siguientes puntos: " & vbCr & vbCr & _
"- abcder " & vbCr & vbCr & _
"- abcder " & vbCr & vbCr & _
"- abderd " & vbCr & vbCr & _
"Usted tiene que llenar " & _
"el siguiente documento adjunto : " & Cells(i, "C").Value & _
" de " & Cells(i, "B").Value & vbCr & vbCr & _
"Saludos cordiales"
dam.attachments.Add "C:\Users\smurayari\Desktop\SIGSO ENERO.xlsx"
dam.Send 'El correo se envía en automático
'dam.Display 'El correo se muestra
End If
Next
MsgBox "Correos enviados"
End Sub

Te entendí mejor. Tienes que cambiar el nombre del archivo y adjuntarlo con ese nuevo nombre y repetir eso en en bucle.

Mira:

Sub Enviar_Correos()
Dim dam As Object
Dim i As Integer
Dim NombreOriginal$, NombreCopia$, ruta$
Let NombreOriginal = "SIGSO ENERO"
Let ruta = "C:\Users\smurayari\Desktop\"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(i, "E").Value = "LIDER DE SI MISMO" Then
        Set dam = CreateObject("outlook.application").createitem(0)
        Let NombreCopia = Cells(i, "C").Value
        Name ruta & NombreOriginal & ".xlsx" As ruta & NombreCopia & ".xlsx"
        With dam
            .To = Cells(i, "F").Value 'Destinatarios
            .Subject = "Recordatorio de seguimiento a pendientes"
            .Body = "Estimado/a : " & Cells(i, "A").Value & vbCr & vbCr & _
                "el 18 se comenzo con la evaluacion de desempeño y se estan viendo los siguientes puntos: " & vbCr & vbCr & _
                    "- abcder " & vbCr & vbCr & _
                        "- abcder " & vbCr & vbCr & _
                            "- abderd " & vbCr & vbCr & _
                                "Usted tiene que llenar " & _
                                    "el siguiente documento adjunto : " & Cells(i, "C").Value & _
                                        " de " & Cells(i, "B").Value & vbCr & vbCr & _
                                                "Saludos cordiales"
            .attachments.Add ruta & NombreCopia & ".xlsx"
            .Send 'El correo se envía en automático
        End With
'dam.Display 'El correo se muestra
         Let NombreOriginal = Cells(i, "C").Value
    End If
Next i
Set dam = Nothing
MsgBox "Correos enviados"
End Sub

Ojo que estoy suponiendo algunas cosas:

- En las celdas de la columna "C", hay nombres a secas, tipo "Abraham" o "Juan Perez", nada de "abraham.xlsx" o "\Juan Perez" o similar

- En las celdas de la columna "C" no hay caracteres no permitidos en nombres de archivos

- El primer archivo antes de correr la macro sí o sí se llama "SIGSO ENERO"

Comentas

Abraham Valencia

Buenos días estimado Abraham, hasta ahí todo perfecto, una última cosa como hago para que los documentos adjuntos le lleguen en conjunto. por ejemplo para un jefe que tiene que evaluar a tres liderados, me esta llegando tres correos y lo que quiero es que me llegue un solo correo por las tres personas a evaluar pero con tres documentos por persona. espero que me haya entendido.

desde ya muchas gracias por su gentil ayuda.

Para que un mismo mensaje llegue a más personas basta hacerlo así:

.To = "[email protected];[email protected];juanitoalimañ[email protected]"

O, por lógica:

.To = Range("A1") & ";" & Range("A2") & ";" & Range("A3")

Para adjuntar más de un archivo:

. Attachments.Add "D:\Miarchivouno.xlsm" 
. Attachments.Add "D:\MiArchivoNuevo.xlsx" 
. Attachments. Add "D:\OtroArchivo.xlsx" 

Cuestión de adaptarlo a lo que necesitas.

Abraham Valencia

Hola Abraham lo que necesito es que le llegue un correo a una persona por ejemplo.

correo para celda A, a esta persona quiero que le llegue un correo en que se le indica que tiene que evaluar a las personas de la celda B, en ese mismo correo quiero adjuntar los documentos.

doc de fong

doc de rojas

doc de ruelas

la formula de ahora esta llegando correo por correo indicándole uno por uno.

Sub Enviar_Correos()
Dim dam As Object
Dim i As Integer
Dim NombreOriginal$, NombreCopia$, ruta$
Let NombreOriginal = "SIGSO ENERO"
Let ruta = "C:\Users\smurayari\Desktop\"
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(i, "E").Value = "LIDER DE SI MISMO" Then
        Set dam = CreateObject("outlook.application").createitem(0)
        Let NombreCopia = Cells(i, "C").Value
        Name ruta & NombreOriginal & ".xlsx" As ruta & NombreCopia & ".xlsx"
        With dam
            .To = Cells(i, "F").Value 'Destinatarios
            .Subject = "Recordatorio de seguimiento a pendientes"
            .Body = "Estimado/a : " & Cells(i, "A").Value & vbCr & vbCr & _
                "el 18 se comenzo con la evaluacion de desempeño y se estan viendo los siguientes puntos: " & vbCr & vbCr & _
                    "- abcder " & vbCr & vbCr & _
                        "- abcder " & vbCr & vbCr & _
                            "- abderd " & vbCr & vbCr & _
                                "Usted tiene que llenar " & _
                                    "el siguiente documento adjunto : " & Cells(i, "C").Value & _
                                        " de " & Cells(i, "B").Value & vbCr & vbCr & _
                                                "Saludos cordiales"
            .attachments.Add ruta & NombreCopia & ".xlsx"
            .Send 'El correo se envía en automático
        End With
'dam.Display 'El correo se muestra
         Let NombreOriginal = Cells(i, "C").Value
    End If
Next i
Set dam = Nothing
MsgBox "Correos enviados"
End Sub