Macro envio sivo de mails con adjunto

Y bienvenida a TodoExpertos.

Podrías poner un ejemplo del nombre del destinatario y cómo se llama el archivo.

¿En cuál carpeta se encuentran los archivos?

¿Cada mes cambian de nombre? Si cambian de nombre, ¿puedes poner ejemplos?

El destinatario se llama P00001 y el archivo P00001 pdf.

El archivo de excell y el pdf están en la misma carpeta.

Los destinatarios suelen ser los mismos, puesto que es la facturación mensual. Pero el código del acreedor suele ser el mismo.

Disculpa no  e exprese en la multa respuesta el código del acreedor siempre es el mismo y el nombre de factura siempre tiene el número del acreedor. Los diferencio por que lo tengo sacado por meses. En cada mes están las facturas correspondientes y el excell con la macro de ese mes.

Prueba la siguiente macro

[code]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
        '
        archivo = ThisWorkbook.Path & "\" & Range("B" & i).Value & ".pdf"
        If Dir(archivo) <> "" Then
          dam.Attachments.Add archivo
        End If
        'dam. Send 'El correo se envía en automático
dam. Display 'El correo se muestra
    Next
    MsgBox "Correos enviados", vbInformation, "

Va otra vez:

[code]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
        '
        archivo = ThisWorkbook.Path & "\" & Range("B" & i).Value & ".pdf"
        If Dir(archivo) <> "" Then
          dam.Attachments.Add archivo
        End If
        'dam. Send 'El correo se envía en automático
dam. Display 'El correo se muestra
    Next
    MsgBox "Correos enviados", vbInformation, "

Al parecer no está funcionando la opción para insertar código:

Entonces lo pongo aquí:

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
'
archivo = ThisWorkbook.Path & "\" & Range("B" & i).Value & ".pdf"
If Dir(archivo) <> "" Then
dam.Attachments.Add archivo
End If
'dam.Send 'El correo se envía en automático
dam.Display 'El correo se muestra
Next
MsgBox "Correos enviados", vbInformation, "

Realiza una prueba y después cambia .Display por .Send

Me Salta un error. Pone

Error de complicación se esperaba End sub.

He probado a borrar la macro y volverla a insertar pero nada.

Perdón ya he puesto send sub, falta eso, pero ahora me sale este error

ya he puesto el Ens Sub, pero ahora me da este error

El editor de la página está cortando la macro. La pongo otra vez:

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
        '
        archivo = ThisWorkbook.Path & "\" & Range("B" & i).Value & ".pdf"
        If Dir(archivo) <> "" Then
          dam.Attachments.Add archivo
        End If
        'dam. Send 'El correo se envía en automático
 dam. Display 'El correo se muestra
    Next
    MsgBox "Correos enviados", vbInformation
End Sub

Comenté el código que tomaba los archivos de las celdas.

Prueba y me comentas.

Buenas, no me trae los archivos.

los archivos se llaman igual al código del proveedor, es decir que si el proveedor p000001 su factura en pdf se llamara p000001

Esto es lo que tú pusiste:

El destinatario se llama P00001 y el archivo P00001 pdf.

Entonces la macro toma el destinatario "P00001" que está en la columna B (en la columna B del archivo de correos masivos están los dstinatarios) y le agrega la extensión .pdf, entonces busca el archivo "P00001.pdf" en la misma carpeta donde tienes el archivo con la macro.

Si lo anterior no es correcto, entonces podrías ser más específica y decirme en dónde tienes el proveedor, un ejemplo y cómo se llama el archivo y un ejemplo.

Pon imágenes de tu hoja de excel y de tu explorador de windows donde yo pueda ver los nombres de los archivos en la carpeta.

estas son las columnas, entonces el archivo siempre se va a llamar como en la columna b.

Pero no pusiste la imagen del explorador de windows para ver en cuál carpeta y el nombre del archivo.

        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"

Y otra cosa muy importante, la macro toma los siguientes datos:

De la columna B el correo del destinatario.

De la columna C un correo para Con copiar

De la columna D un correo para Con copia oculta

De la columna E el asunto

De la columna F el cuerpo del mensaje

De la columna H el archivo

Pero en tu imagen cambiaste las posiciones, ¿entonces estás modificando la macro de acuerdo a tus columnas?

Si, he modificado la macro de acuerdo a mis columnas, el archivo se encuentra en una carpeta de teams. Que se llama facturas enviadas