Estaba trabajando en un proyecto que enviará correo masivo a diferentes personas si se cumplen las condiciones.
Condiciones :
- La columna U contiene el estado final (Abierto o WIP) (no se enviará si está Cerrado, sin importar si la fecha actual es mayor)
- La columna Q contiene la fecha de cierre. Lo cual, en comparación con la fecha actual, es menos que los correos electrónicos de disparo automático a las personas.
Intenté hacerlo con el bucle for pero está generando 4 correos electrónicos con la misma dirección y CC. Y no pasar a la siguiente fila para comparar.
Comparación de celdas V2 con Q2, luego bucle V3 con Q3 y en la misma mano verifique si la celda U2 tiene "Abierto"
Gracias de antemano.
Codifique como se muestra a continuación:
Sub Data_RoundedRectangle1_Click()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String
On Error Resume Next
For i = 1 to 4
If Sheets("Data").Range("U2:U6").Value2 = "Open" Or Sheets("Data").Range("U2:U6").Value2 = "WIP" And (CDate(Cells(2, 17).Value) < Now()) Then
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
Set rng = Sheets("Checklist").Range("A2:B25").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
If Worksheets("Data").Cells(i, "C").Value2 = "Operation_Support" And Worksheets("Data").Cells(i, "E").Value2 = "Quality_Assurance" Then
StrBody = "Hi," & "<br>" & _
.To = "a"
.CC = "b"
.BCC = ""
.Subject = ""
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
'.Send
ElseIf Worksheets("Data").Cells(i, "C").Value = "Operation_Support" And Worksheets("Data").Cells(i, "E").Value = "Analytics" Then
StrBody = "Hi," & "<br>" & _
"PFB the process details which requires your attention." & "<br>" & _
"The review for this process has crossed over due." & "<br>" & _
"Please ask the process owner to review the Process Manuals and Maps." & "<br><br><br>"
.To = "c"
.CC = "d"
.BCC = ""
.Subject = "Process Manual and Maps Review is Overdue"
.HTMLBody = StrBody & RangetoHTML(rng)
.Attachments.Add ActiveWorkbook.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
.Display
'.Send
End If
End With
i = i + 1
Exit For
End If
End If
Next r
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next x
End Sub
Respuesta1
Creo que es por tu bucle.
For i = 1 to 4
Pero nunca haces referencia i
, así que está funcionando.todocuatro veces. Deberías usarlo así en su lugar:
If Sheets("Data").cells(21,1+i).Value2 = "Open" Or Sheets("Data").cells(21,1+i).Value2 = "WIP" And ...
No estoy del todo seguro de a qué if
se refiere la segunda parte, pero entiendes la esencia.