Questo browser non è più supportato.
Esegui l'aggiornamento a Microsoft Edge per sfruttare i vantaggi di funzionalità più recenti, aggiornamenti della sicurezza e supporto tecnico.
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
Buongiorno, sto cercando la soluzione al mio problema, ma non ho trovato quella giusta. Il problema è questo:
Ho un file excel con un elenco di persone e le scadenze loro scadenze (ad esempio documento, corso. Ecc...).
Attualmente, il mio alert è la formattazione condizionale, con la quale mi compare una "X" e la cella rossa se scaduto oppure cella vuota in verde se in corso di validità.
Vorrei sapere come fare in modo che excel, prima della scadenza, invii una mail di promemoria per il rinnovo alla persona che ha la scadenza prossima, (chiaramente solo alle persone che stanno per scadere e non alle altre).
Esempio:
A. B. C. D
1 Nome e cognome mail. Scadenza. Alert
2 Tizio sempronio. Xxxxx. 01/09/24. X
3 Caio morello. Xxxxxx. 01/12/24
4 Ciccillo rossi. Xxxxxx. 05/08/24. X
Grazie
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.
Sì, certo. Ti basta sostituire il codice.
Ciao, si, tornerebbe molto utile.
Posso sostituite direttamente il codice?
Ho già quasi totalmente compilato il file con i dati.
Aggiungendo ovviamente anche la regola della formattazione condizionale
Ciao Salvatore,
ho testato un po' il file con la versione di office 2013 e sembra funzionare correttamente.
Visto che c'ero ho gestito anche l'ipotesi in cui la data di scadenza, rispetto al giorno in cui viene fatto il controllo aprendo il file, risulti scaduta, con possibilità di inviare anche una mail indicando che il documento o il corso risulta scaduto (e con check sull'invio già effettuato).
Nella formattazione condizionale ho inserito una ulteriore regola con un altro sfondo (viola).
Ti metto il link drop box a questa versione modificata:
Invio automatico e-mail promemoria excel 2019 #3.xlsm
Riporto anche la routine modificata aggiungendo la condizione e modificando i testi utilizzati per ogni situazione:
Sub CreaEmailScadenze(Optional oLoRow As Variant)
Dim StartRow As Long
Dim oLoRows As Long
Dim i As Long, j As Long
Dim DataAvviso6m As Date
Dim DataAvviso3m As Date
Dim DataAvviso1m As Date
Dim DataAvviso15g As Date
Dim DataScadenza As Date
Dim sGrado As String
Dim sCognome As String
Dim sNome As String
Dim sEmail As String
Dim sTipoDocCorso As String
Dim sNomeDocCorso As String
Dim sStringaCheck As String
Dim sCheck As String
Dim bSendMail As Boolean
Dim sTempoMancante As String
Dim sTestoOggettoMail As String
Dim sTestoCorpoMail As String
With oLoPC
If IsMissing(oLoRow) Then
StartRow = 1
oLoRows = .ListRows.Count
Else
StartRow = oLoRow
oLoRows = oLoRow
End If
For i = StartRow To oLoRows
sGrado = .ListColumns("GRADO").DataBodyRange(i).Value
sCognome = .ListColumns("COGNOME").DataBodyRange(i).Value
sNome = .ListColumns("NOME").DataBodyRange(i).Value
sEmail = .ListColumns("POSTA ELETTRONICA").DataBodyRange(i).Value
For j = 1 To NDoc
bSendMail = False
DataScadenza = .ListColumns("DATA DI SCADENZA D" & j).DataBodyRange(i).Value
sTipoDocCorso = "documento"
sNomeDocCorso = .ListColumns("NUMERO D" & j).Range(1).Offset(-1).Value
sCheck = .ListColumns("CHECK D" & j).DataBodyRange(i).Value
If DataScadenza <> "00:00:00" Then
DataAvviso6m = DateAdd("M", -6, DataScadenza)
DataAvviso3m = DateAdd("M", -3, DataScadenza)
DataAvviso1m = DateAdd("M", -1, DataScadenza)
DataAvviso15g = DateAdd("D", -15, DataScadenza)
If Date >= DataAvviso6m And Date < DataAvviso3m Then
If InStr(1, sCheck, "6m") = 0 Then bSendMail = True
sStringaCheck = "6m"
sTempoMancante = " mancano meno di sei mesi alla scadenza."
ElseIf Date >= DataAvviso3m And Date < DataAvviso1m Then
If InStr(1, sCheck, "3m") = 0 Then bSendMail = True
sStringaCheck = "3m"
sTempoMancante = " mancano meno di tre mesi alla scadenza."
ElseIf Date >= DataAvviso1m And Date < DataAvviso15g Then
If InStr(1, sCheck, "1m") = 0 Then bSendMail = True
sStringaCheck = "1m"
sTempoMancante = " manca meno di un mese alla scadenza."
ElseIf Date >= DataAvviso15g And Date < DataScadenza Then
If InStr(1, sCheck, "15g") = 0 Then bSendMail = True
sStringaCheck = "15g"
sTempoMancante = " mancano meno quindici giorni alla scadenza."
ElseIf Date >= DataScadenza Then
If InStr(1, sCheck, "scad") = 0 Then bSendMail = True
sStringaCheck = "scad"
sTempoMancante = " risulta ad oggi scaduto."
End If
If bSendMail Then
sTestoOggettoMail = sGrado & " " & sCognome & " " & sNome & " - " & _
"Avviso scadenza " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" con data scadenza " & DataScadenza
sTestoCorpoMail = "Egr. " & sGrado & " " & sCognome & " " & sNome & "," & Chr(10) & _
"si avvisa che per il " & sTipoDocCorso & " """ & sNomeDocCorso & _
"""con data scadenza " & DataScadenza & sTempoMancante & String(2, Chr(10)) & _
"Cordiali saluti"
Call CreaEmailHtml(sEmail, sTestoOggettoMail, sTestoCorpoMail, , , , bInviaEmailAutomaticamente)
If sCheck = "" Then
sCheck = sStringaCheck
Else
sCheck = sCheck & "," & sStringaCheck
End If
.ListColumns("CHECK D" & j).DataBodyRange(i).Value = sCheck
End If
End If
Next j
For j = 1 To NCorsi
bSendMail = False
DataScadenza = .ListColumns("SCADENZA C" & j).DataBodyRange(i).Value
sTipoDocCorso = "corso"
sNomeDocCorso = .ListColumns("ULTIMO C" & j).Range(1).Offset(-1).Value
sCheck = .ListColumns("CHECK C" & j).DataBodyRange(i).Value
If DataScadenza <> "00:00:00" Then
DataAvviso6m = DateAdd("M", -6, DataScadenza)
DataAvviso3m = DateAdd("M", -3, DataScadenza)
DataAvviso1m = DateAdd("M", -1, DataScadenza)
DataAvviso15g = DateAdd("D", -15, DataScadenza)
If Date >= DataAvviso6m And Date < DataAvviso3m Then
If InStr(1, sCheck, "6m") = 0 Then bSendMail = True
sStringaCheck = "6m"
sTempoMancante = " mancano meno di sei mesi alla scadenza."
ElseIf Date >= DataAvviso3m And Date < DataAvviso1m Then
If InStr(1, sCheck, "3m") = 0 Then bSendMail = True
sStringaCheck = "3m"
sTempoMancante = " mancano meno di tre mesi alla scadenza."
ElseIf Date >= DataAvviso1m And Date < DataAvviso15g Then
If InStr(1, sCheck, "1m") = 0 Then bSendMail = True
sStringaCheck = "1m"
sTempoMancante = " manca meno di un mese alla scadenza."
ElseIf Date >= DataAvviso15g And Date < DataScadenza Then
If InStr(1, sCheck, "15g") = 0 Then bSendMail = True
sStringaCheck = "15g"
sTempoMancante = " mancano meno quindici giorni alla scadenza."
ElseIf Date >= DataScadenza Then
If InStr(1, sCheck, "scad") = 0 Then bSendMail = True
sStringaCheck = "scad"
sTempoMancante = " risulta ad oggi scaduto."
End If
If bSendMail Then
sTestoOggettoMail = sGrado & " " & sCognome & " " & sNome & " - " & _
"Avviso scadenza " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" con data scadenza " & DataScadenza
sTestoCorpoMail = "Egr. " & sGrado & " " & sCognome & " " & sNome & "," & Chr(10) & _
"si avvisa che per il " & sTipoDocCorso & " """ & sNomeDocCorso & _
"""con data scadenza " & DataScadenza & sTempoMancante & String(2, Chr(10)) & _
"Cordiali saluti"
Call CreaEmailHtml(sEmail, sTestoOggettoMail, sTestoCorpoMail, , , , bInviaEmailAutomaticamente)
If sCheck = "" Then
sCheck = sStringaCheck
Else
sCheck = sCheck & "," & sStringaCheck
End If
.ListColumns("CHECK C" & j).DataBodyRange(i).Value = sCheck
End If
End If
Next j
Next i
End With
End Sub
Vedi se ti può essere utile.
ciao
Ciao, stavo provando sempre dal PC di casa, ma come al solito non va per via della versione di outlook.
Domattina inserirò tutti i dati e farò nuovamente il test.
Ti terrò aggiornato.
Grazie
Ciao Salvatore,
se vuoi fare dei testo su questa nuova versione del file ti metto il link
Invio automatico e-mail promemoria excel 2019 #2.xlsm
Ti spiego l'approccio e vedi tu se ti sembra funzionale per le tue esigenze.
La particolarità è che nell'unica colonna di "check" (naturalmente per ogni data di scadenza dei documenti e corsi) viene inserita una stringa che rappresenta l'email per il termine mancante alla scadenza.
In particolare "6m" (scadenza entro 6 mesi o meno), "3m" (scadenza entro 3 mesi o meno), "1m" (scadenza entro 1 mese o meno) e "15g" (scadenza entro 15 giorni o meno).
Se ci si trova in uno di quei periodi e nella cella della check non è presente la relativa stringa verrà creata l'email.
Man mano che vengono inviate le email per i diversi tempi di scadenza la cella del "check" conterrà tutte le relative stringe separate da una virgola (6m,3m,1m,15g).
Il codice nel modulo1 è un po' cambiato.
Ho eliminato una costante (quella che serviva per impostare il periodo di tempo alla scadenza) visto che ora i periodi sono 4.
E un'altra costante, quella che inseriva la "X" nella cella della "check", è ora diventata una variabile all'intero della routine "CreaEmailScadenze".
Oltre al fatto che ho cambiato approccio per determinare quella che, prima, era la data di avviso.
Ora, per gestire i vari intervalli, ho dichiarato quattro variabili che, partendo dalla data di scadenza, e andando in dietro nel tempo, calcolano la date date che, confrontate con la data "odierna", verificano se mancano da 6 mesi fino a 3 mesi, poi da 3 mesi a 1 mese, da 1 mese a 15 giorni, e da 15 giorni in giù.
Questo il codice sempre presente in Modulo1 (riporto nuovamente tutto anche le parti non modificate):
Option Explicit
Public Const NDoc As Long = 2 '<=== in caso di aggiunta di nuovi documenti indicare qui il numero complessivo di documenti
Public Const NCorsi As Long = 11 '<=== in caso di aggiunta di nuovi corsi indicare qui il numero complessivo dei corsi
Public Const sNomeFoglioPC As String = "Pandettamento_Corsi" '<=== nome foglio dati pandettamento e corsi
Public Const sNomeTabellaPC As String = "TabellaPandettamentoCorsi" '<=== nome tabella dati pandettamento e corsi
Public Const bInviaEmailAutomaticamente As Boolean = False '<=== impostare True per invio immediato dell'email
'Public Const sStringaCheck As String = "X" '<=== se si volesse iserire un diverso carattere per il check modificare qui
Function oLoPC() As ListObject
Set oLoPC = ThisWorkbook.Worksheets(sNomeFoglioPC).ListObjects(sNomeTabellaPC)
End Function
Sub CreaEmailScadenze(Optional oLoRow As Variant)
Dim StartRow As Long
Dim oLoRows As Long
Dim i As Long, j As Long
Dim DataAvviso6m As Date
Dim DataAvviso3m As Date
Dim DataAvviso1m As Date
Dim DataAvviso15g As Date
Dim DataScadenza As Date
Dim sGrado As String
Dim sCognome As String
Dim sNome As String
Dim sEmail As String
Dim sTipoDocCorso As String
Dim sNomeDocCorso As String
Dim sStringaCheck As String
Dim sCheck As String
Dim bSendMail As Boolean
Dim sTempoMancante As String
Dim sTestoOggettoMail As String
Dim sTestoCorpoMail As String
With oLoPC
If IsMissing(oLoRow) Then
StartRow = 1
oLoRows = .ListRows.Count
Else
StartRow = oLoRow
oLoRows = oLoRow
End If
For i = StartRow To oLoRows
sGrado = .ListColumns("GRADO").DataBodyRange(i).Value
sCognome = .ListColumns("COGNOME").DataBodyRange(i).Value
sNome = .ListColumns("NOME").DataBodyRange(i).Value
sEmail = .ListColumns("POSTA ELETTRONICA").DataBodyRange(i).Value
For j = 1 To NDoc
bSendMail = False
DataScadenza = .ListColumns("DATA DI SCADENZA D" & j).DataBodyRange(i).Value
sTipoDocCorso = "documento"
sNomeDocCorso = .ListColumns("NUMERO D" & j).Range(1).Offset(-1).Value
sCheck = .ListColumns("CHECK D" & j).DataBodyRange(i).Value
If DataScadenza <> "00:00:00" Then
DataAvviso6m = DateAdd("M", -6, DataScadenza)
DataAvviso3m = DateAdd("M", -3, DataScadenza)
DataAvviso1m = DateAdd("M", -1, DataScadenza)
DataAvviso15g = DateAdd("D", -15, DataScadenza)
If Date >= DataAvviso6m And Date < DataAvviso3m Then
If InStr(1, sCheck, "6m") = 0 Then bSendMail = True
sStringaCheck = "6m"
sTempoMancante = "sei mesi"
ElseIf Date >= DataAvviso3m And Date < DataAvviso1m Then
If InStr(1, sCheck, "3m") = 0 Then bSendMail = True
sStringaCheck = "3m"
sTempoMancante = "tre mesi"
ElseIf Date >= DataAvviso1m And Date < DataAvviso15g Then
If InStr(1, sCheck, "1m") = 0 Then bSendMail = True
sStringaCheck = "1m"
sTempoMancante = "un mese"
ElseIf Date >= DataAvviso15g Then
If InStr(1, sCheck, "15g") = 0 Then bSendMail = True
sStringaCheck = "15g"
sTempoMancante = "quindici giorni"
End If
If bSendMail Then
sTestoOggettoMail = sGrado & " " & sCognome & " " & sNome & " - " & _
"Avviso scadenza " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" con data scadenza " & DataScadenza
sTestoCorpoMail = "Egr. " & sGrado & " " & sCognome & " " & sNome & "," & Chr(10) & _
"si avvisa che per il " & sTipoDocCorso & " """ & sNomeDocCorso & _
"""con data scadenza " & DataScadenza & " mancano meno di " & sTempoMancante & " alla scadenza." & String(2, Chr(10)) & _
"Cordiali saluti"
Call CreaEmailHtml(sEmail, sTestoOggettoMail, sTestoCorpoMail, , , , bInviaEmailAutomaticamente)
If sCheck = "" Then
sCheck = sStringaCheck
Else
sCheck = sCheck & "," & sStringaCheck
End If
.ListColumns("CHECK D" & j).DataBodyRange(i).Value = sCheck
End If
End If
Next j
For j = 1 To NCorsi
bSendMail = False
DataScadenza = .ListColumns("SCADENZA C" & j).DataBodyRange(i).Value
sTipoDocCorso = "corso"
sNomeDocCorso = .ListColumns("ULTIMO C" & j).Range(1).Offset(-1).Value
sCheck = .ListColumns("CHECK C" & j).DataBodyRange(i).Value
If DataScadenza <> "00:00:00" Then
DataAvviso6m = DateAdd("M", -6, DataScadenza)
DataAvviso3m = DateAdd("M", -3, DataScadenza)
DataAvviso1m = DateAdd("M", -1, DataScadenza)
DataAvviso15g = DateAdd("D", -15, DataScadenza)
If Date >= DataAvviso6m And Date < DataAvviso3m Then
If InStr(1, sCheck, "6m") = 0 Then bSendMail = True
sStringaCheck = "6m"
sTempoMancante = "sei mesi"
ElseIf Date >= DataAvviso3m And Date < DataAvviso1m Then
If InStr(1, sCheck, "3m") = 0 Then bSendMail = True
sStringaCheck = "3m"
sTempoMancante = "tre mesi"
ElseIf Date >= DataAvviso1m And Date < DataAvviso15g Then
If InStr(1, sCheck, "1m") = 0 Then bSendMail = True
sStringaCheck = "1m"
sTempoMancante = "un mese"
ElseIf Date >= DataAvviso15g Then
If InStr(1, sCheck, "15g") = 0 Then bSendMail = True
sStringaCheck = "15g"
sTempoMancante = "quindici giorni"
End If
If bSendMail Then
sTestoOggettoMail = sGrado & " " & sCognome & " " & sNome & " - " & _
"Avviso scadenza " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" con data scadenza " & DataScadenza
sTestoCorpoMail = "Egr. " & sGrado & " " & sCognome & " " & sNome & "," & Chr(10) & _
"si avvisa che per il " & sTipoDocCorso & " """ & sNomeDocCorso & _
"""con data scadenza " & DataScadenza & " mancano meno di " & sTempoMancante & " alla scadenza." & String(2, Chr(10)) & _
"Cordiali saluti"
Call CreaEmailHtml(sEmail, sTestoOggettoMail, sTestoCorpoMail, , , , bInviaEmailAutomaticamente)
If sCheck = "" Then
sCheck = sStringaCheck
Else
sCheck = sCheck & "," & sStringaCheck
End If
.ListColumns("CHECK C" & j).DataBodyRange(i).Value = sCheck
End If
End If
Next j
Next i
End With
End Sub
Sub CreaEmailHtml(sTo As String, _
sOggettoEmail As String, _
sTestoEmail As String, _
Optional sCC As String, _
Optional sCCN As String, _
Optional sAllegati As String, _
Optional bSendMail As Boolean = False)
Dim oOutlook As Object
Dim oMail As Object
Dim arrAllegati As Variant
Dim i As Long
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.CreateItem(0)
With oMail
.BodyFormat = 2 'HTML
.Display
.To = Trim(sTo)
.cc = Trim(sCC)
.BCC = Trim(sCCN)
If .To = "" And _
.cc = "" And _
.BCC = "" Then
bSendMail = False
End If
.Subject = Trim(sOggettoEmail)
sTestoEmail = Replace(Trim(sTestoEmail), Chr(10), "<br>")
sTestoEmail = "<HTML><BODY><p style='font-family:Calibri;font-size:11pt'>" & sTestoEmail & "</p></BODY></HTML>"
.HTMLBody = sTestoEmail & .HTMLBody
.ReadReceiptRequested = True
.OriginatorDeliveryReportRequested = .ReadReceiptRequested
On Error Resume Next
If sAllegati <> "" Then
arrAllegati = Split(sAllegati, ";")
For i = 0 To UBound(arrAllegati)
.Attachments.Add Trim(arrAllegati(i))
If Err.Number <> 0 Then
MsgBox "L'allegato" & vbNewLine & Trim(arrAllegati(i)) & vbNewLine & _
"non è stato trovato!", vbExclamation, "Errore Allegato"
bSendMail = False
Err.Clear
End If
Next i
End If
On Error GoTo 0
If bSendMail Then .send
End With
Set oOutlook = Nothing
Set oMail = Nothing
End Sub
Fai dei test con i tuoi dati reali e aggiusta il testo delle email a piacimento.
Per come ho impostato io il testo ottengo delle email del genere:
Ciao
p.s. nelle colonne delle date di scadenza ho inserito quattro formattazioni condizionali con differenti sfondi a seconda di quanto manchi alla scadenza.
Vedi tu se mantenerle o modificarle.