Excel - Ayuda en cuerpo de corrreo desde excel a outlook

 
Vista:
sin imagen de perfil
Val: 18
Ha disminuido su posición en 4 puestos en Excel (en relación al último mes)
Gráfica de Excel

Ayuda en cuerpo de corrreo desde excel a outlook

Publicado por Fernando (6 intervenciones) el 01/03/2021 07:46:18
Buenas noches, estoy tratando de enviar un correo con vba en excel, buscando por la web encontré un codigo, lo malo es que cuando ya estoy en el mail, primero pega el rango de celdas seleccionadas y luego escribe el texto ( "hola buenos dias...."), cuando primero debería poner el texo de comunicación (hola buenos dias etc)y luego el cuadro con rango seleccionado (que es lo que esta de azul). Dejo el codigo y una imagen, espero alguien pueda ayudarme, saludos.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub correo()
Dim Info As string
Info = Sheets("Sheet3").Range("b2").Value
Sheets("Reporte (2)").Range("b6:o76).SpecialCells(xlCellTypeVisible).Copy
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.CreateItem(olMailItem)
Parte2.To = "destinatario@blabla.com"
Parte2.Subject = "asunto de mensaje"
Parte2.Body = Info
Parte2.Display
Application.Sendkeys "^v"
Set parte1 = Nothing
Set ´parte2 = Nothing
End Sub

thumbnail_IMG_5297
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 Andres Leonardo
Val: 3.136
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Ayuda en cuerpo de corrreo desde excel a outlook

Publicado por Andres Leonardo (1583 intervenciones) el 01/03/2021 16:37:56
mira como te sale asi?

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub correo()
Dim Info As string
Info = Sheets("Sheet3").Range("b2").Value
Sheets("Reporte (2)").Range("b6:o76).SpecialCells(xlCellTypeVisible).Copy
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.CreateItem(olMailItem)
Parte2.To = "destinatario@blabla.com"
Parte2.Subject = "asunto de mensaje"
Parte2.Body = "Hola este es un mensaje de prueba que debe salir antes de la info" & VbCr
Parte2.Body = Parte2.Body & Info
Parte2.Display
Application.Sendkeys "^v"
Set parte1 = Nothing
Set ´parte2 = Nothing
End Sub
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: 18
Ha disminuido su posición en 4 puestos en Excel (en relación al último mes)
Gráfica de Excel

Ayuda en cuerpo de corrreo desde excel a outlook

Publicado por Fernando (6 intervenciones) el 08/03/2021 02:23:58
Estimado Andrés, gracias por tu respuesta, intenté con tu código, pero todavía no consigo lo que quiero, voy a dejar mi archivo para que lo puedas revisar mejor, en mi archivo solo hay una lista de 5 personas , pero creo que eso es suficiente para que puedas intuir que es lo que estoy buscando hacer (enviar a cada destinatario la información que le corresponde) también dejo una imagen de cómo debería quedar el cuerpo del correo que se envía, espero tu o alguien más pueda ayudarme ya que siento que estoy muy cerca de lo que quiero pero necesito de ayuda, gracias.

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
Sub Enviar_Correos()
 
ThisWorkbook.Sheets("Sheet2").Select
 
x = ThisWorkbook.Sheets("Sheet2").Range("c5").Value
For i = 1 To x
ThisWorkbook.Sheets("Sheet2").Range("c6").Value = i
 
Dim A As Outlook.Application
Dim email As Outlook.Mailitem
Dim cambio As String
Dim cortar As String
 
cambio = Range("B9").Select
ActiveCell.FormulaR1C1 = "=+VLOOKUP(R[-3]C[1],Sheet1!R2C1:R5000C3,3,0)"
 
cortar = Sheets("Sheet2").Range("b11:o32").SpecialCells(xlCellTypeVisible).Copy
 
 
 
Set A = New Outlook.Application
 
Set email = A.CreateItem(emailItem)
    With email
 
        .To = ThisWorkbook.Sheets("Sheet2").Range("c2").Value
        .Subject = ThisWorkbook.Sheets("Sheet2").Range("c3").Value
        .Body = ""
        .Display
        .Send
 
Application.SendKeys "^v"
 
 
    End With
 
Next i
 
    Set email = Nothing
    Set A = Nothing
 
End Sub

Capture
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