Macro envio sivo de mails con adjunto
El archivo de excel con la macro para enviar correos es perfecta, pero tengo que enviar 300 correos mensualmente, me gustaría que me ayudase a modificar su macro para que en vez de buscar el documento pueda pegar la ruta del archivo que quiero adjuntar o que me los traiga de forma automática ya que el archivo se guarda con el nombre del destinatario.
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 SubComenté 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
¿Y ya te funciona?
¿Puedes poner aquí tu código modificado?
Y exactamente cómo se llama la carpeta? ejemplo: "c:\bla bla\etc\etc"
Si en H2 tienes el dato p00001.pdf entonces en la carpeta "c:\bla bla\etc\etc" debes tener un archivo p00001.pdf
Puedes poner aquí la imagen de explorar de windows donde yo pueda ver el nombre de la carpeta y el nombre del archivo.
