Continuar enviando correos con celda vacía
Publicado por Fernando (6 intervenciones) el 14/03/2021 20:07:48
Hola, tengo una macro que envía correos desde excel a outllook, el problema es que la columna de destinatarios (Para:) siempre tendrá un correo, pero la columna de copia no (CC:) ya que algunos solicitan copia y otros no, al ser de esta forma, cuando ejecuto la macro, esta corre cuando en ambas columnas hay correos, pero si en la columna de copia no encuentra un correo se detiene y outlook arroja una ventana con correos donde sugiere elegir uno, como no quiero ninguno de los correos que sugiere entonces pongo cancelar y continua con el envío hasta que encuentra otra celda vacía y otra vez se detiene y hace lo mismo, aparte, cuando le doy cancelar, ya no envía al destinatario que correspondía, sino que se pasa al otro, es decir , ya no envía el correo al destinatario que no tiene copia, cómo podría solucionarlo?, dejo mi código, archivo y unas fotos para que se pueda entender mejor, saludos y gracias por su ayuda.


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
Sub Enviar_Correos()
ThisWorkbook.Sheets("Sheet2").Select
x = ThisWorkbook.Sheets("Sheet2").Range("c6").Value
For i = 1 To x
ThisWorkbook.Sheets("Sheet2").Range("c7").Value = i
Dim cambio As String
Dim cortar As String
Sheets("Sheet2").Select
cambio = Range("B10").Select
ActiveCell.FormulaR1C1 = "=+VLOOKUP(R[-3]C[1],Sheet1!R2C1:R5000C3,3,0)"
cortar = Sheets("Sheet2").Range("b16:o86").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("b16:o86").SpecialCells(xlCellTypeVisible).Copy
Sheets("Correo").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Rows("5:5").Select
Selection.RowHeight = 24
Range("A1").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.To = ThisWorkbook.Sheets("Sheet2").Range("c2").Value
.Item.CC = ThisWorkbook.Sheets("Sheet2").Range("c3").Value
.Item.Subject = ThisWorkbook.Sheets("Sheet2").Range("c3").Value
.Introduction = ""
.Item.Send
End With
Next i
End Sub

- Book1.zip(22,9 KB)
Valora esta pregunta


1