I have a RunTime error 1004

[MiyagiZama]

Hello mates, hope you're fine

The reason of this message is that: I want to send some tables and grafics by outlook email but I cant find the way to send it with MailEnvelope, and using the offset for send separately this information by 1 mail per person with the personal information of the agent, here it is the VBA code and some ss of the error and the table which I used to get the information to send the Email

Thank you so much!

Sub MACROSUPPLYCHAIN()
'
'
Dim TotalComentarios As String
Dim ComentariosLlenados As String
Dim PastDue As String
Dim cell As Range
Dim Correo As String
Dim Destinatario As String
Dim Asunto As String
Dim shF As Worksheet
Dim Dates As String

'
'
Set shF = Sheets("FormatoCorreo")
'
'
'Seleccionamos el rango de celdas a enviar Select
shF.Activate
'
  'Aumentar 10 filas
  'ESCRIBIMOS NUESTRO MENSAJE EN LAS CELDAS QUE AÑADIMOS YA QUE EL MAIL ENVELOPE NO TIENE ATRIBUTOS PARA CAMBIAR TAMAÑO O COLOR DE FONT
  'POSTERIORMENTE LE AUMENTAMOS EL TAMAÑO Y PONEMOS EN NEGRITAS EL TEXTO QUE DESEAMOS
  ActiveSheet.Rows("1:11").Insert

'
'Recorremos la columna EMAIL
'
For Each cell In Range("B2:B13")
'
'
'Mostramos la sección para enviar correo.
Set OutlookApp = New Outlook.Application
'
'ASIGNAMOS VALOR A LAS VARIABLES
With ThisWorkbook.Sheets("InformacionNecesaria")
Correo = cell.Value
Destinatario = cell.Offset(0, -1).Value
TotalComentarios = cell.Offset(0, 3).Value
ComentariosLlenados = cell.Offset(0, 2).Value
PastDue = cell.Offset(0, 1).Value
Asunto = "Ordenes en Past Due y Comentarios "
Dates = Range("H3").Value
End With
'
'
 'Cuerpo del mensaje
        '
 Range("A1").Value = "Apreciables colegas, espero que se encuentren excelente el dia de hoy."
  Range("A3").Value = "El motivo de este correo es para informarle que tiene estas ordenes en Past Due: " & PastDue
  Range("A5").Value = "Asi como le comentamos que tiene constestados: " & ComentariosLlenados & " de" & TotalComentarios
  Range("A7").Value = "Favor de apoyarnos llenando los comentarios y confirmando el ETA:"
  Range("A8").Value = "Quedamos al pendiente"
  Range("A10").Value = "ESTO ES UNA PRUEBA FAVOR DE OMITIR"
  Range("A1:A10").Font.Size = 16
  Range("A10").Font.Bold = True
'
'Llamamos al envío...
'
'
ActiveWorkbook.EnvelopeVisible = True
  With ActiveSheet.MailEnvelope
    .Item.To = Destinatario
    .Item.Subject = "Ordenes en Past Due y Comentarios " & Dates
    .Item.Send
  End With
     '
  Next
  '
  '
'BORRAR LAS FILAS QUE AÑADIMOS Y LAS COLUMNAS DE LA TABLA QUE ENVIAMOS POR CORREO
  shF.Rows("A1:A11").Delete
  ActiveWorkbook.EnvelopeVisible = False
  MsgBox "El correo ha sido enviado con exito"
End Sub

 

[DanteAmor]

You have some problems in your code.
I made several modifications.

When you work with more than one sheet, you must always reference the sheet.
Notice how before each range I put the reference to the shF or shI sheet.

According to your image, the emails are in column B, so the Destinatario must be filled with the data of the cell that you have in the for each cell cycle.

Sub MACROSUPPLYCHAIN()
  Dim OutlookApp As Object
  Dim shF As Worksheet, shI As Worksheet
  Dim TotalComentarios As String, ComentariosLlenados As String
  Dim Destinatario As String, Asunto As String
  Dim PastDue As String, Dates As String
  Dim cell As Range
  '
  Set shF = Sheets("FormatoCorreo")
  Set shI = Sheets("InformacionNecesaria")
  '
  'Aumentar 10 filas
  'ESCRIBIMOS NUESTRO MENSAJE EN LAS CELDAS QUE AÑADIMOS YA QUE EL MAIL ENVELOPE NO TIENE ATRIBUTOS PARA CAMBIAR TAMAÑO O COLOR DE FONT
  'POSTERIORMENTE LE AUMENTAMOS EL TAMAÑO Y PONEMOS EN NEGRITAS EL TEXTO QUE DESEAMOS
  shF.Rows("1:11").Insert
  '
  'Recorremos la columna EMAIL
  For Each cell In shI.Range("B2:B13")
    'Mostramos la sección para enviar correo.
    Set OutlookApp = New Outlook.Application
    '
    'ASIGNAMOS VALOR A LAS VARIABLES
      Destinatario = cell.Value                     'en esta celda tienes el correo
      TotalComentarios = cell.Offset(0, 3).Value
      ComentariosLlenados = cell.Offset(0, 2).Value
      PastDue = cell.Offset(0, 1).Value
      Asunto = "Ordenes en Past Due y Comentarios "
      Dates = shI.Range("H3").Value
    '
    'Cuerpo del mensaje
    shF.Range("A1").Value = "Apreciables colegas, espero que se encuentren excelente el dia de hoy."
    shF.Range("A3").Value = "El motivo de este correo es para informarle que tiene estas ordenes en Past Due: " & PastDue
    shF.Range("A5").Value = "Asi como le comentamos que tiene constestados: " & ComentariosLlenados & " de" & TotalComentarios
    shF.Range("A7").Value = "Favor de apoyarnos llenando los comentarios y confirmando el ETA:"
    shF.Range("A8").Value = "Quedamos al pendiente"
    shF.Range("A10").Value = "ESTO ES UNA PRUEBA FAVOR DE OMITIR"
    shF.Range("A1:A10").Font.Size = 16
    shF.Range("A10").Font.Bold = True
    '
    'Llamamos al envío...
    ActiveWorkbook.EnvelopeVisible = True
    With shF.MailEnvelope
      .Item.To = Destinatario
      .Item.Subject = "Ordenes en Past Due y Comentarios " & Dates
      .Item.Send
    End With
  '
  Next
  '
  '
  'BORRAR LAS FILAS QUE AÑADIMOS Y LAS COLUMNAS DE LA TABLA QUE ENVIAMOS POR CORREO
  shF.Rows("1:11").Delete
  ActiveWorkbook.EnvelopeVisible = False
  MsgBox "El correo ha sido enviado con exito"
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[MiyagiZama]

You have some problems in your code.
I made several modifications.

When you work with more than one sheet, you must always reference the sheet.
Notice how before each range I put the reference to the shF or shI sheet.

According to your image, the emails are in column B, so the Destinatario must be filled with the data of the cell that you have in the for each cell cycle.

Sub MACROSUPPLYCHAIN()
  Dim OutlookApp As Object
  Dim shF As Worksheet, shI As Worksheet
  Dim TotalComentarios As String, ComentariosLlenados As String
  Dim Destinatario As String, Asunto As String
  Dim PastDue As String, Dates As String
  Dim cell As Range
  '
  Set shF = Sheets("FormatoCorreo")
  Set shI = Sheets("InformacionNecesaria")
  '
  'Aumentar 10 filas
  'ESCRIBIMOS NUESTRO MENSAJE EN LAS CELDAS QUE AÑADIMOS YA QUE EL MAIL ENVELOPE NO TIENE ATRIBUTOS PARA CAMBIAR TAMAÑO O COLOR DE FONT
  'POSTERIORMENTE LE AUMENTAMOS EL TAMAÑO Y PONEMOS EN NEGRITAS EL TEXTO QUE DESEAMOS
  shF.Rows("1:11").Insert
  '
  'Recorremos la columna EMAIL
  For Each cell In shI.Range("B2:B13")
    'Mostramos la sección para enviar correo.
    Set OutlookApp = New Outlook.Application
    '
    'ASIGNAMOS VALOR A LAS VARIABLES
      Destinatario = cell.Value                     'en esta celda tienes el correo
      TotalComentarios = cell.Offset(0, 3).Value
      ComentariosLlenados = cell.Offset(0, 2).Value
      PastDue = cell.Offset(0, 1).Value
      Asunto = "Ordenes en Past Due y Comentarios "
      Dates = shI.Range("H3").Value
    '
    'Cuerpo del mensaje
    shF.Range("A1").Value = "Apreciables colegas, espero que se encuentren excelente el dia de hoy."
    shF.Range("A3").Value = "El motivo de este correo es para informarle que tiene estas ordenes en Past Due: " & PastDue
    shF.Range("A5").Value = "Asi como le comentamos que tiene constestados: " & ComentariosLlenados & " de" & TotalComentarios
    shF.Range("A7").Value = "Favor de apoyarnos llenando los comentarios y confirmando el ETA:"
    shF.Range("A8").Value = "Quedamos al pendiente"
    shF.Range("A10").Value = "ESTO ES UNA PRUEBA FAVOR DE OMITIR"
    shF.Range("A1:A10").Font.Size = 16
    shF.Range("A10").Font.Bold = True
    '
    'Llamamos al envío...
    ActiveWorkbook.EnvelopeVisible = True
    With shF.MailEnvelope
      .Item.To = Destinatario
      .Item.Subject = "Ordenes en Past Due y Comentarios " & Dates
      .Item.Send
    End With
  '
  Next
  '
  '
  'BORRAR LAS FILAS QUE AÑADIMOS Y LAS COLUMNAS DE LA TABLA QUE ENVIAMOS POR CORREO
  shF.Rows("1:11").Delete
  ActiveWorkbook.EnvelopeVisible = False
  MsgBox "El correo ha sido enviado con exito"
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

You have some problems in your code.
I made several modifications.

When you work with more than one sheet, you must always reference the sheet.
Notice how before each range I put the reference to the shF or shI sheet.

According to your image, the emails are in column B, so the Destinatario must be filled with the data of the cell that you have in the for each cell cycle.

Sub MACROSUPPLYCHAIN()
  Dim OutlookApp As Object
  Dim shF As Worksheet, shI As Worksheet
  Dim TotalComentarios As String, ComentariosLlenados As String
  Dim Destinatario As String, Asunto As String
  Dim PastDue As String, Dates As String
  Dim cell As Range
  '
  Set shF = Sheets("FormatoCorreo")
  Set shI = Sheets("InformacionNecesaria")
  '
  'Aumentar 10 filas
  'ESCRIBIMOS NUESTRO MENSAJE EN LAS CELDAS QUE AÑADIMOS YA QUE EL MAIL ENVELOPE NO TIENE ATRIBUTOS PARA CAMBIAR TAMAÑO O COLOR DE FONT
  'POSTERIORMENTE LE AUMENTAMOS EL TAMAÑO Y PONEMOS EN NEGRITAS EL TEXTO QUE DESEAMOS
  shF.Rows("1:11").Insert
  '
  'Recorremos la columna EMAIL
  For Each cell In shI.Range("B2:B13")
    'Mostramos la sección para enviar correo.
    Set OutlookApp = New Outlook.Application
    '
    'ASIGNAMOS VALOR A LAS VARIABLES
      Destinatario = cell.Value                     'en esta celda tienes el correo
      TotalComentarios = cell.Offset(0, 3).Value
      ComentariosLlenados = cell.Offset(0, 2).Value
      PastDue = cell.Offset(0, 1).Value
      Asunto = "Ordenes en Past Due y Comentarios "
      Dates = shI.Range("H3").Value
    '
    'Cuerpo del mensaje
    shF.Range("A1").Value = "Apreciables colegas, espero que se encuentren excelente el dia de hoy."
    shF.Range("A3").Value = "El motivo de este correo es para informarle que tiene estas ordenes en Past Due: " & PastDue
    shF.Range("A5").Value = "Asi como le comentamos que tiene constestados: " & ComentariosLlenados & " de" & TotalComentarios
    shF.Range("A7").Value = "Favor de apoyarnos llenando los comentarios y confirmando el ETA:"
    shF.Range("A8").Value = "Quedamos al pendiente"
    shF.Range("A10").Value = "ESTO ES UNA PRUEBA FAVOR DE OMITIR"
    shF.Range("A1:A10").Font.Size = 16
    shF.Range("A10").Font.Bold = True
    '
    'Llamamos al envío...
    ActiveWorkbook.EnvelopeVisible = True
    With shF.MailEnvelope
      .Item.To = Destinatario
      .Item.Subject = "Ordenes en Past Due y Comentarios " & Dates
      .Item.Send
    End With
  '
  Next
  '
  '
  'BORRAR LAS FILAS QUE AÑADIMOS Y LAS COLUMNAS DE LA TABLA QUE ENVIAMOS POR CORREO
  shF.Rows("1:11").Delete
  ActiveWorkbook.EnvelopeVisible = False
  MsgBox "El correo ha sido enviado con exito"
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

Excellent, and How can I put the range of the tables and the graphics that I need to send?... here's a pic of the range

 

[DanteAmor]

Excellent, and How can I put the range of the tables and the graphics that I need to send?... here's a pic of the range

With the MailEnvelope method you only send one sheet.
To send data from other sheets, you can copy the range of the "pivottables" sheet under the information of the "FormatoCorreo" sheet and the same with the graph.


You must adjust the range where you have the graph.
Try this:

Sub MACROSUPPLYCHAIN()
  Dim OutlookApp As Object
  Dim shF As Worksheet, shI As Worksheet
  Dim TotalComentarios As String, ComentariosLlenados As String
  Dim Destinatario As String, Asunto As String
  Dim PastDue As String, Dates As String
  Dim cell As Range
  Dim lr1 As Long, lr2 As Long
  '
  Set shF = Sheets("FormatoCorreo")
  Set shI = Sheets("InformacionNecesaria")
  '
  'Aumentar 10 filas
  'ESCRIBIMOS NUESTRO MENSAJE EN LAS CELDAS QUE AÑADIMOS YA QUE EL MAIL ENVELOPE NO TIENE ATRIBUTOS PARA CAMBIAR TAMAÑO O COLOR DE FONT
  'POSTERIORMENTE LE AUMENTAMOS EL TAMAÑO Y PONEMOS EN NEGRITAS EL TEXTO QUE DESEAMOS
  shF.Rows("1:11").Insert
  lr1 = shF.Range("A" & Rows.Count).End(3).Row
  '
  'copia la tabla
  With Sheets("Pivottables")
    .Range("A1:G" & .Range("A" & Rows.Count).End(3).Row).Copy shF.Range("A" & lr1 + 2)
  End With
  DoEvents
 
  'copia la gráfica
  With Sheets("Dashboard")
    lr2 = shF.Range("A" & Rows.Count).End(3).Row
    .Range("A1:G20").Copy shF.Range("A" & lr2 + 2)
  End With
  DoEvents
 
  'Recorremos la columna EMAIL
  For Each cell In shI.Range("B2:B13")
    'Mostramos la sección para enviar correo.
    Set OutlookApp = New Outlook.Application
    '
    'ASIGNAMOS VALOR A LAS VARIABLES
      Destinatario = cell.Value                     'en esta celda tienes el correo
      TotalComentarios = cell.Offset(0, 3).Value
      ComentariosLlenados = cell.Offset(0, 2).Value
      PastDue = cell.Offset(0, 1).Value
      Asunto = "Ordenes en Past Due y Comentarios "
      Dates = shI.Range("H3").Value
    '
    'Cuerpo del mensaje
    shF.Range("A1").Value = "Apreciables colegas, espero que se encuentren excelente el dia de hoy."
    shF.Range("A3").Value = "El motivo de este correo es para informarle que tiene estas ordenes en Past Due: " & PastDue
    shF.Range("A5").Value = "Asi como le comentamos que tiene constestados: " & ComentariosLlenados & " de" & TotalComentarios
    shF.Range("A7").Value = "Favor de apoyarnos llenando los comentarios y confirmando el ETA:"
    shF.Range("A8").Value = "Quedamos al pendiente"
    shF.Range("A10").Value = "ESTO ES UNA PRUEBA FAVOR DE OMITIR"
    shF.Range("A1:A10").Font.Size = 16
    shF.Range("A10").Font.Bold = True
    '
    'Llamamos al envío...
    ActiveWorkbook.EnvelopeVisible = True
    With shF.MailEnvelope
      .Item.To = Destinatario
      .Item.Subject = "Ordenes en Past Due y Comentarios " & Dates
      .Item.Send
    End With
  '
  Next
  '
  '
  'BORRAR LAS FILAS QUE AÑADIMOS Y LAS COLUMNAS DE LA TABLA QUE ENVIAMOS POR CORREO
  shF.Rows(lr1 + 1 & ":" & Rows.Count).Clear
  shF.Rows("1:11").Delete
  ActiveWorkbook.EnvelopeVisible = False
  MsgBox "El correo ha sido enviado con exito"
End Sub

NOTE:
If it doesn't copy the table or graph correctly, you'll have to copy it once and delete it at the end.