Cuerpo de un correo vba Excel
Publicado por David (6 intervenciones) el 29/08/2018 17:41:52
Buen día .
Quería ayuda respecto a una macro que esta vinculada con outlook.
Lo que pasa es que toda la macro la hace muy bien el único detalle es que a la hora de escribir el cuerpo de correo no me lo pone como yo quisiera.
De esta forma es como me gustaría que estuviera el cuerpo del mensaje
"Buenos días.
Anexo información de contratos.
Agregar la imagen que copie (Con el comando Application.SendKeys "^v")
Saludos"
anexo el código si alguien me pudiera ayudar ya que a veces solo copia la imagen y a veces solo manda el texto
Quería ayuda respecto a una macro que esta vinculada con outlook.
Lo que pasa es que toda la macro la hace muy bien el único detalle es que a la hora de escribir el cuerpo de correo no me lo pone como yo quisiera.
De esta forma es como me gustaría que estuviera el cuerpo del mensaje
"Buenos días.
Anexo información de contratos.
Agregar la imagen que copie (Con el comando Application.SendKeys "^v")
Saludos"
anexo el código si alguien me pudiera ayudar ya que a veces solo copia la imagen y a veces solo manda el texto
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub correo()
n = Cells(3, 4).CurrentRegion.Rows.Count
n = n - 2
Dim texto As String
Dim i, j As IntegerDim pagina1 As Worksheet
Set pagina1 = ActiveWorkbook.Worksheets("Hoja1")
Dim OutApp As Object
Dim correo As Object
With Application
.EnableEvents = False
.ScreenUpdating = True
End With
'Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
On Error Resume Next
Set OutApp = GetObject("", "Outlook.Application")
Err.ClearIf OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
OutApp.Visible = True
Set correo = OutApp.CreateItem(0)
'Crear el correo y mostrarlo
With correo
n = Cells(2, 4).CurrentRegion.Rows.Count
.To = pagina1.Range("C10").Value
.Subject = pagina1.Range("C12").Value
'Selecciona un rango de celdas
Range(Cells(2, 1), Cells(n + 1, 4)).Select
'Convierte un rango de celdas en mapa de Bits
Worksheets("Hoja1").Range(Cells(2, 1), Cells(n + 1, 4)).CopyPicture xlScreen, xlBitmap
Cells(15, 1).Select
.HTMLBody'Congela el programa 5 segundos
Application.Wait (Now + TimeValue("00:00:05"))
'Pega en rango de celdas copiado como imagen
Application.SendKeys "^v"
.Body = "Buenos días" & Chr(vbKeyReturn)
.Body = .Body & "Anexo información relacionada con los contratos" & Chr(vbKeyReturn) & Chr(vbKeyReturn)
.Body = .Body & ""
.Body = .Body & "Saludos" & Chr(vbKeyReturn)
'UserForm1.Show
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
Application.CutCopyMode = False
End With
With correo
.SendEnd With
End Sub
Valora esta pregunta
0
