Macro Envío masivo de mails con formato y archivo adjunto
Dam, ¿cómo estás?
En la macro que me mandaste para enviar correos (que corre de maravilla), Intento darle formato al cuerpo del mensaje pero no he podido, el texto queda corrido o se corta.
Vi que me mandaste una que ya me da el formato, la comienzo a ver, ok.
Dam, de verdad Muchísimas Gracias por tu ayuda .
Gracias, Buen Día.
2 respuestas
Respuesta de Dante Amor
1
Te anexo la macro completa para enviar correo y formatear el texto.
'***Macro Para enviar correos
Sub correo()
'Por.Dante Amor
'col = Range("H1").Column
Application.ScreenUpdating = False
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
dam.body = Range("F" & i) '"Cuerpo del mensaje"
'
'For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
j = Range("H1").Column
Do While Cells(i, j) <> ""
archivo = Cells(i, j)
If Cells(i, j) <> "" Then dam.Attachments.Add archivo
j = j + 1
Loop
dam.display 'El correo se muestra
Application.Wait Now + TimeValue("00:00:01")
DoEvents
celdas = Array(26, 27, 28, 29)
For j = LBound(celdas) To UBound(celdas)
Cells(i, celdas(j)).Copy
negritas
Next
'Centrar
SendKeys "%fac", True
celdas = Array(30, 31)
For j = LBound(celdas) To UBound(celdas)
Cells(i, celdas(j)).Copy
sangria
Next
dam.send 'El correo se envía en automático
Set dam = Nothing
'dam.display 'El correo se muestra
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub
Sub negritas()
'Por.Dante Amor
SendKeys "^{HOME}", True
DoEvents
'Para buscar 2007
SendKeys "%ffbu", True
DoEvents
SendKeys "^v", True
DoEvents
Application.Wait Now + TimeValue("00:00:01")
SendKeys "{ENTER}", True
DoEvents
SendKeys "{ESC}", True
DoEvents
'Para negritas 2007
SendKeys "%f1", True
DoEvents
End Sub
Sub sangria()
'Por.Dante Amor
SendKeys "^{HOME}", True
DoEvents
'Para buscar 2007
SendKeys "%ffbu", True
DoEvents
SendKeys "^v", True
DoEvents
Application.Wait Now + TimeValue("00:00:01")
SendKeys "{ENTER}", True
DoEvents
SendKeys "{ESC}", True
DoEvents
'Para sangría
SendKeys "{LEFT}", True
DoEvents
SendKeys "{TAB}", True
DoEvents
End Sub
