Reenvío de correo y salto de celda vacía
Publicado por Fernando (6 intervenciones) el 14/03/2021 01:28:50
Hola, tengo una macro que envía correos desde excel a outlook, pero ahora necesito reenviarlos, es decir, de la lista que tengo, en un primer envío, se les envía a toda lista, como es obvio, del total de la lista unos me responderán y otros no, entonces necesito reenviar solo a los que no me han respondido, había pensado poner un checkbox (si hay una mejor manera les agradeceré me comenten) y en un principio tener el checkbox activado para todos, para así poder enviar a todos al principio, pero luego tendría que desactivar todos y solo activar a los que quiera reenviar, y eso es lo que no consigo hacer, adicional a eso, también necesito que si en caso en la columna donde están los mails faltara uno por cualquier motivo, que la macro siga corriendo y no se detenga, dejo el código, mi archivo y una foto de la lista donde solo hay 5 correos como ejemplo, pero son más mails para enviar, agradezco su ayuda, 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
44
45
46
47
48
Sub Enviar_Correos()
ThisWorkbook.Sheets("Sheet2").Select
x = ThisWorkbook.Sheets("Sheet2").Range("c5").Value
For i = 1 To xThisWorkbook.Sheets("Sheet2").Range("c6").Value = i
Dim cambio As String
Dim cortar As String
Sheets("Sheet2").Select
cambio = Range("B9").Select
ActiveCell.FormulaR1C1 = "=+VLOOKUP(R[-3]C[1],Sheet1!R2C1:R5000C3,3,0)"
cortar = Sheets("Sheet2").Range("b15:o85").SpecialCells(xlCellTypeVisible).Copy
Sheets("Correo").Select
Rows("5:5").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("A5").Select
Sheets("Sheet2").Range("b15:o85").SpecialCells(xlCellTypeVisible).Copy
Sheets("Correo").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.PasteRows("5:5").Select
Selection.RowHeight = 24
Range("A1").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope.Item.To = ThisWorkbook.Sheets("Sheet2").Range("c2").Value
.Item.Subject = ThisWorkbook.Sheets("Sheet2").Range("c3").Value
.Introduction = ""
.Item.Send
End With
Next i
End Sub
Valora esta pregunta
0