Envío masivo mails rango de celdas de excel

Responde en el siguiente orden:

1. Pon una imagen con ejemplos para ver cómo tienes los datos en la hoja.

2. Una imagen de cómo quieres los datos en el correo.

3. ¿De dónde se obtiene el correo para cada proveedor?

4. Qué va en el asunto del correo.

Son tus Excel los que estuve probando! sos un genio, te paso

1-

2-

3- Tengo un listado en excel con proveedor y direcciones

4- Depende quien mande el correo por lo general es "estado OCs al "fecha", o Sr "proveedor" le adjuntamos las OC al "fecha"

Así es como se esta enviando hoy, te pase solo un proveedor abajo esta el siguiente y así casi que 100 proveedores en un archivo de 5mil líneas.

Gracias!

Responde en el siguiente orden:

1. No veo en tu imagen las filas y las columnas de excel. Pon otra imagen completa. Y dime cuál es la columna del proveedor para agrupar.

2. En el ejemplo pon 2 proveedores.

3. ¿Quieres qué en el correo se pegue como imagen o como tabla?

Tengo un listado en excel con proveedor y direcciones

4. Pon el listado, la imagen con ese listado, que se vean las filas y las columnas de excel y los nombres de las hojas.

de nuevo muchas gracias, completo

1 -esta es la base con toda la info, corto y pego para editar a como te pase

2- OK, ahi estarian todas las OC de 2 proveedores

3- me da igual, si es mas facil tabla tabla, si es mas facil imagen imagen, solo que como veras, no todos los proveedores tienen las mismas cantidad de ordenes

4-  no tiene mucho, solo el codigo del proveedor (que es igual a la columna N del archivo anterior (si justo no tengo esos proveedores porque tengo una base vieja)

muchas gracias!

Me auto respondo porque vi que me falto algo, se puede agrupar por la columna A que tiene el nombre del proveedor, o por la N que me trae el numero del proveedor, es la que estaba usando con el combinar correspondencia.

Sigue las indicaciones:

1. La hoja "Base Mails Proveedores", deberá estar en el mismo libro.

2. La macro toma la columna N para agrupar y para obtener el correo de cada proveedor.

3. Actualiza en estas líneas el asunto del correo:

      .Subject = "Estado OCs al " & Format(Date, "dd/mm/yyyy")
      .HTMLBody = "Estimado proveedor le informamos el estado de sus órdenes <br>" & _
                  RangetoHTML(rng) & _
                  "<br> Muchas gracias."

4. Cambia en esta línea .Display por .Send para enviar los correos:

. Display 'cambiar a .Send para enviar

5. Si tienes algún problema de la macro, me dices el mensaje de error y en cuál línea de la macro se detiene.

6. Pon todo el siguiente código en un módulo y ejecuta la macro "Enviar_Correo_a_Proveedores"

Sub Enviar_Correo_a_Proveedores()
  Dim c As Range, f As Range
  Dim sh As Worksheet, s2 As Worksheet, s3 As Worksheet
  Dim ky As Variant
  Dim a, b
  '
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .DisplayAlerts = False
  End With
  '
  Set sh = Sheets("ResumenProv")
  Set s2 = Sheets("Base Mails Proveedores")
  Set s3 = Sheets.Add
  '
  With CreateObject("scripting.dictionary")
    For Each c In sh.Range("N6", sh.Range("N" & Rows.Count).End(3))
      If c.Value <> "" Then
        Set f = s2.Range("A:A").Find(c, , xlValues, xlWhole)
        If Not f Is Nothing Then
          .Item(c.Value) = f.Offset(0, 3).Value
        End If
      End If
    Next c
    For Each ky In .Keys
      s3.Cells.Clear
      sh.Range("A5").AutoFilter Columns("N").Column, ky
      sh.AutoFilter.Range.EntireRow.Copy s3.Range("A1")
      Call Mail_Selection_Range_Outlook_Body(s3, ky, .Item(ky))
    Next ky
  End With
  sh.ShowAllData
  s3.Delete
  '
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
  End With
End Sub
'
Sub Mail_Selection_Range_Outlook_Body(s3, prov, correo)
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Don't forget to copy the function RangetoHTML in the module.
'Working in Excel 2000-2016
  Dim rng As Range
  Dim OutApp As Object
  Dim OutMail As Object
  '
  Set rng = Nothing
  On Error Resume Next
  Set rng = s3.Range("A1:M" & s3.Range("A" & Rows.Count).End(3).Row)
  On Error GoTo 0
'
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  '
  On Error Resume Next
  With OutMail
    .To = correo
    .Subject = "Estado OCs al " & Format(Date, "dd/mm/yyyy")
    .HTMLBody = "Estimado proveedor le informamos el estado de sus órdenes <br>" & _
                RangetoHTML(rng) & _
                "<br> Muchas gracias."
    .Display  'cambiar a .Send para enviar
  End With
  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub
'
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'TempFile = "C:\trabajo\temp.htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    '
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Tengo que decir que sos un genio, funciona perfecto, con esto es pasar de 0 a un millón, te consulto dos cosas

1- ¿Hay posibilidad de agregar el nombre del proveedor a el asunto? Para que quede fluvial SA, le comparto el estado de OC al

.Subject = "Estado OCs al " & Format(Date, "dd/mm/yyyy")
      .HTMLBody = "Estimado proveedor le informamos el estado de sus órdenes 
" & _
                  RangetoHTML(rng) & _
                  "
Muchas gracias."

2 le puse formato al texto el cual lo toma el mail genial, pero en las primeras 2 columnas se me enciman, aunque en el excel les de mas espacio y se lea bien en el mail se se corta, hay forma de ajustarlo? en el mail si lo toco despues me deja abrirlo

3 note tambien que si pongo los varios mails separados con ; como en tu otro archivo se los manda a los varios mails, gracias por eso!