I am developing an expiration control that should send notices to people that the documents are close to expiration, there are documents that should be charged 180 days before the expiration date and others with only 30 days, the idea is that this VBA instead of sending 1200 documents in several emails, send a list of expired documents to people, for example: to analyst Valeria we must send the collection of more than 100 documents that are expired, but instead of sending 100 emails, create a list and send it in a single email leaving its management in copy. Below is the code and photo of the spreadsheet:
I made this code, but it is not meeting my real need:
Sub alerta_email()
Dim MeuOutlook As Outlook.Application
Dim CriarEmail As Outlook.MailItem
Range("E14").Activate
Do Until ActiveCell.Value = ""
If ActiveCell.Offset(0, 1).Value < Range ("F14").Value or ActiveCell.Offset(0, 1).Value < Range ("F15").Value Then
Set MeuOutlook = New Outlook.Application
Set CriarEmail = MeuOutlook.CreateItem(olMailItem)
With CriarEmail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Automatic alert" & "<br>" & "The document: " _
& ActiveCell.Offset(0,2).Value & " Belonging to the group " _
& ActiveCell.Offset(0, -3).Value & " It will expire in " _
& ActiveCell.Offset(0, 1).Value & " days."
.To = Range("N14").Value
.CC = Range ("O14").Value
.Subject = "Contract expiration alert: " &
ActiveCell.Offset(0, -2).Value
.Send
End With
End If
ActiveCell.Offset(1, 0).Select
Loop
MsgBox ("Alert sent successfully")
End Sub
When I run the macro it is also considering the documents that are not expired. And the entire list she is considering sending only to Ana and her manager, instead of considering another analyst and another manager of this analyst.
Workbook]1 Workbook 2]2
| Nome | Ano de vencimento | Dias para renovaçao | Garantia | Analista | Supervisor | |||||||||
| ABC | 09/08/2023 | 180 | Promissory note | [email protected] | [email protected] | |||||||||
| DEF | 22/07/2023 | 30 | Promissory note | [email protected] | [email protected] | |||||||||
| GHI | 22/07/1931 | 30 | Insurance policy | [email protected] | [email protected] | |||||||||
| JKL | 14/05/1932 | 30 | Insurance policy | [email protected] | [email protected] | |||||||||
| MNO | 22/05/2024 | 30 | Promissory note | [email protected] | [email protected] | |||||||||
| PQR | 22/07/1931 | 30 | Promissory note | [email protected] | [email protected] |
I am developing an expiration control that should send notices to people that the documents are close to expiration, there are documents that should be charged 180 days before the expiration date and others with only 30 days, the idea is that this VBA instead of sending 1200 documents in several emails, send a list of expired documents to people, for example: to analyst Valeria we must send the collection of more than 100 documents that are expired, but instead of sending 100 emails, create a list and send it in a single email leaving its management in copy. Below is the code and photo of the spreadsheet:
I made this code, but it is not meeting my real need:
Sub alerta_email()
Dim MeuOutlook As Outlook.Application
Dim CriarEmail As Outlook.MailItem
Range("E14").Activate
Do Until ActiveCell.Value = ""
If ActiveCell.Offset(0, 1).Value < Range ("F14").Value or ActiveCell.Offset(0, 1).Value < Range ("F15").Value Then
Set MeuOutlook = New Outlook.Application
Set CriarEmail = MeuOutlook.CreateItem(olMailItem)
With CriarEmail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Automatic alert" & "<br>" & "The document: " _
& ActiveCell.Offset(0,2).Value & " Belonging to the group " _
& ActiveCell.Offset(0, -3).Value & " It will expire in " _
& ActiveCell.Offset(0, 1).Value & " days."
.To = Range("N14").Value
.CC = Range ("O14").Value
.Subject = "Contract expiration alert: " &
ActiveCell.Offset(0, -2).Value
.Send
End With
End If
ActiveCell.Offset(1, 0).Select
Loop
MsgBox ("Alert sent successfully")
End Sub
When I run the macro it is also considering the documents that are not expired. And the entire list she is considering sending only to Ana and her manager, instead of considering another analyst and another manager of this analyst.
Workbook]1 Workbook 2]2
| Nome | Ano de vencimento | Dias para renovaçao | Garantia | Analista | Supervisor | |||||||||
| ABC | 09/08/2023 | 180 | Promissory note | [email protected] | [email protected] | |||||||||
| DEF | 22/07/2023 | 30 | Promissory note | [email protected] | [email protected] | |||||||||
| GHI | 22/07/1931 | 30 | Insurance policy | [email protected] | [email protected] | |||||||||
| JKL | 14/05/1932 | 30 | Insurance policy | [email protected] | [email protected] | |||||||||
| MNO | 22/05/2024 | 30 | Promissory note | [email protected] | [email protected] | |||||||||
| PQR | 22/07/1931 | 30 | Promissory note | [email protected] | [email protected] |
Assuming your analista column is properly sort and that column P is avaiable, try this:
Option Explicit
Sub alerta_email()
Dim MeuOutlook As Outlook.Application
Dim CriarEmail As Outlook.MailItem
Dim RngDataVencimento As Range
Dim RngDiaMargem As Range
Dim RngMailAnalista As Range
Dim RngMailSupervisor As Range
Dim RngGarantia As Range
Dim RngNome As Range
Dim RngRelatorio As Range
Dim DblIndice As Double
Dim StrListaExpiracao As String
Dim StrListaSupervisor As String
Set RngDataVencimento = Range("E13")
Set RngDiaMargem = Range("F13")
Set RngMailAnalista = Range("N13")
Set RngMailSupervisor = Range("O13")
Set RngGarantia = Range("G13")
Set RngNome = Range("B13")
Set RngRelatorio = Range("P13") '<If column P is already taken, pick another one
DblIndice = 0
Do
DblIndice = DblIndice + 1
Set MeuOutlook = New Outlook.Application
Set CriarEmail = MeuOutlook.CreateItem(olMailItem)
If RngDataVencimento.Offset(DblIndice, 0).Value2 - RngDiaMargem.Offset(DblIndice, 0).Value2 <= Date Then
If RngRelatorio.Offset(DblIndice, 0).Value2 = "" Then
If RngMailAnalista.Offset(DblIndice, 0).Value2 <> RngMailAnalista.Offset(DblIndice - 1, 0).Value2 Then
StrListaExpiracao = "Automatic alert" & "<br>" & "<br>" & _
"The document: " & RngGarantia.Offset(DblIndice, 0).Value2 & _
" Belonging to the group " & RngNome.Offset(DblIndice, 0).Value2 & _
" It will expire in " & CDbl(RngDataVencimento.Offset(DblIndice, 0).Value2 - Date) & _
" days." & "<br>"
StrListaSupervisor = RngMailSupervisor.Offset(DblIndice, 0) & ";"
Else
StrListaExpiracao = StrListaExpiracao & _
"The document: " & RngGarantia.Offset(DblIndice, 0).Value2 & _
" Belonging to the group " & RngNome.Offset(DblIndice, 0).Value2 & _
" It will expire in " & CDbl(RngDataVencimento.Offset(DblIndice, 0).Value2 - Date) & _
" days." & "<br>"
Select Case Len(StrListaSupervisor)
Case Is = 0
StrListaSupervisor = RngMailSupervisor.Offset(DblIndice, 0) & ";"
Case Is = Len(Replace(StrListaSupervisor, RngMailSupervisor.Offset(DblIndice, 0), ""))
StrListaSupervisor = StrListaSupervisor & RngMailSupervisor.Offset(DblIndice, 0) & ";"
End Select
End If
RngRelatorio.Offset(DblIndice, 0).Value2 = Date
End If
End If
If RngMailAnalista.Offset(DblIndice, 0).Value2 <> RngMailAnalista.Offset(DblIndice + 1, 0).Value2 Then
If StrListaExpiracao <> "" Then
With CriarEmail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = StrListaExpiracao
.To = RngMailAnalista.Offset(DblIndice, 0).Value2
.CC = StrListaSupervisor
.Subject = "Contract expiration alert"
.Send
End With
End If
StrListaSupervisor = ""
StrListaExpiracao = ""
End If
Loop Until RngDataVencimento.Offset(DblIndice + 1).Value2 = ""
MsgBox ("Alert sent successfully")
End Sub