Como insertar rangos de tablas en el cuerpo de un correo teniendo una macro de envió de correos?
publicado
Buenas Tardes
Tengo una macro que me envía de forma masiva correos a una lista en Excel que ya tengo predeterminada (empresas y Usuarios), pero requiero enviarle a cada uno de las empresas que se encuentren en esta lista una información especifica que tengo en una tabla (encabezados e información) pero no queremos enviarla en tipo texto sino tal cual esta en la tabla de Excel
Adjunto código que utilizo para el envío de los correos
Buenas Tardes
Tengo una macro que me envía de forma masiva correos a una lista en Excel que ya tengo predeterminada (empresas y Usuarios), pero requiero enviarle a cada uno de las empresas que se encuentren en esta lista una información especifica que tengo en una tabla (encabezados e información) pero no queremos enviarla en tipo texto sino tal cual esta en la tabla de Excel
Adjunto código que utilizo para el envío de los correos
Sub envio_mailprueba()
Application.ScreenUpdating = False
Dim outlookOBJ As Object
Dim mitem As Object
Dim OutMail As Object
Dim fso As Object
Dim ts As Object
Dim strbody As String
Dim Ruta As String
Dim Firma As String
Range("E22").Select
Range(Selection, Selection.End(xlDown)).Select
nume_regi = Selection.Count
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
strbody = "Buenos días" & vbNewLine & vbNewLine
Ruta = "C:/Users/lorjuela/AppData/Roaming/Microsoft/Firmas/lUIS FDO ORJUELA.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(Ruta).OpenAsTextStream(1, -2)
Firma = ts.readall
ts.Close
On Error Resume Next
For i = 1 To nume_regi
Set outlookOBJ = CreateObject("Outlook.Application")
Set mitem = outlookOBJ.CreateItem(olMailItem)
asunto = Cells(5, 5)
ruta_archivo = Cells(6, 5).Value
Cuerpo = Cells(9, 2)
empresa = Cells(21 + i, 5)
Enviara = Cells(21 + i, 6)
Copia = Cells(21 + i, 7)
With mitem
.To = Enviara
.CC = Copia
.Subject = asunto & " PARA " & empresa
.Body = strbody & Cuerpo & vbNewLine & vbNewLine & vbNewLine & Firma
'.Send
End With
With mitem
.Send
End With
Next i
Range("E5").Select
Application.ScreenUpdating = True
Set outlookOBJ = Nothing
Set mitem = Nothing
MsgBox ("Finalizado se enviaron " & nume_regi & " Correos con exito"), vbOKOnly, "Correos enviados"
Exit Sub
End Sub
En espera de su apreciada ayuda! Mil Gracias