Excel - Cuerpo de un correo vba Excel

 
Vista:
sin imagen de perfil
Val: 10
Ha disminuido 1 puesto en Excel (en relación al último mes)
Gráfica de Excel

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



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 Integer
Dim 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.Clear
If 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
.Send
End With
 
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.146
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Cuerpo de un correo vba Excel

Publicado por Antoni Masana (1456 intervenciones) el 30/08/2018 08:22:43
Esto es lo mejor que he conseguido.

Buenos días
Anexo información relacionada con los contratos


Saludos

+---------------+
| .................|
+---------------+


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
Sub correo()
    Dim OutApp As Object, texto As String, n As Integer, pagina1 As Worksheet, _
        correo As Object
 
    Set pagina1 = ActiveWorkbook.Worksheets("Hoja1")
 
    Application.EnableEvents = False
    Application.ScreenUpdating = True
 
    ' ---&--- Comprobar si Outlook esta abierto y en caso de no estarlo abrirlo
 
    Set OutApp = CreateObject("Outlook.Application")
    Set correo = OutApp.CreateItem(0)
 
    ' ---&--- Convierte un rango de celdas en mapa de Bits
 
    n = pagina1.Cells(2, 4).CurrentRegion.Rows.Count
    pagina1.Range(Cells(2, 1), Cells(n + 1, 4)).CopyPicture xlScreen, xlBitmap
 
    ' ---&--- Crear el correo y mostrarlo
 
    With correo
        .To = pagina1.Range("C10").Value
        .Subject = pagina1.Range("C12").Value
        .Display
        .Body = "Buenos días" & vbCrLf & _
                "Anexo información relacionada con los contratos" & vbCrLf & _
                vbCrLf
 
        Application.Wait (Now + TimeValue("00:00:01")): Application.SendKeys "^v":
        Application.Wait (Now + TimeValue("00:00:01"))
 
        .Body = .Body & vbCrLf & "Saludos" & vbCrLf & vbCrLf & vbCrLf
        .Send
    End With
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        Application.CutCopyMode = False
    End With
    Cells(15, 1).Select
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 10
Ha disminuido 1 puesto en Excel (en relación al último mes)
Gráfica de Excel

Cuerpo de un correo vba Excel

Publicado por David (6 intervenciones) el 30/08/2018 16:24:00
Muchas gracias por la información es que con esa macro a la hora que pone el "saludos" borra toda la información antes, pero ya encontre una forma alternativa para resolverlo.

Muchas gracias por su ayuda y tiempo.
Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar