Mostrar msbox todo junto al final en "For each cell in rng"
Quería saber si existe alguna forma de acumular los mensajes para el final de la siguiente macro:
Quería saber si existe alguna forma de acumular los mensajes para el final de la siguiente macro:
Sub Enviar_individual()
Dim rng As Range, cell As Range
Set rng = Range("bloque1, bloque2, bloque3, bloque4, bloque5, bloque6, bloque7, bloque8")
For Each cell In rng
If cell <> "" Then
Application.EnableEvents = False
dest = Application.WorksheetFunction.VLookup(cell.Value, Sheets("Matriculados").Range("matriz_matriculados"), 11, False)
If dest = "" Then
MsgBox "Matricula " & cell.Value & " sin correo", vbInformation, "ATENCION"
Else
hora_insp = Format(Application.WorksheetFunction.VLookup(cell.Offset(0, -7).Value, Sheets("Listas").Range("horarios_m"), 2, False), "hh:mm")
Set part1 = CreateObject("outlook.application")
Set part2 = part1.CreateItem(olMailItem)
part2.To = dest
part2.Subject = "Aviso de inspección"
part2.Body = "mensaje de aviso"
part2.display
Application.EnableEvents = True
End If
End If
Next cell
End Sub
Cuando dest = "" quiere decir que no hay ningún correo electrónico para enviar, entonces muestra un msgbox avisando y sigue con la siguiente celda.
Mi pregunta es si se puede hacer que siga con la siguiente celda y al final de todo muestre un msgbox diciendo todos los que no tenían correo electrónico, ya que se hace tedioso darle "ok" a cada msgbox que va apareciendo. Cuando dest = "" quiere decir que no hay ningún correo electrónico para enviar, entonces muestra un msgbox avisando y sigue con la siguiente celda.
Mi pregunta es si se puede hacer que siga con la siguiente celda y al final de todo muestre un msgbox diciendo todos los que no tenían correo electrónico, ya que se hace tedioso darle "ok" a cada msgbox que va apareciendo.
1 Respuesta
Respuesta de Dante Amor
3
Prueba lo siguiente:
Sub Enviar_individual()
Dim rng As Range, cell As Range
Dim dest As Variant
Dim hora_insp As String, cad As String
Dim part1 As Object, part2 As Object
'
Set rng = Range("bloque1, bloque2, bloque3, bloque4, bloque5, bloque6, bloque7, bloque8")
For Each cell In rng
If cell <> "" Then
Application.EnableEvents = False
dest = Application.WorksheetFunction.VLookup(cell.Value, Sheets("Matriculados").Range("matriz_matriculados"), 11, False)
If dest = "" Then
cad = cad & cell.Value & vbCr
Else
hora_insp = Format(Application.WorksheetFunction.VLookup(cell.Offset(0, -7).Value, Sheets("Listas").Range("horarios_m"), 2, False), "hh:mm")
Set part1 = CreateObject("outlook.application")
Set part2 = part1.CreateItem(olMailItem)
part2.To = dest
part2.Subject = "Aviso de inspección"
part2.Body = "mensaje de aviso"
part2.display
Application.EnableEvents = True
End If
End If
Next cell
'
If cad <> "" Then
MsgBox "Matriculas sin correo:" & vbCr & cad, vbExclamation, "ATENCION"
Else
MsgBox "Correos enviados", vbInformation, "ATENCION"
End If
End Sub
