Invio automatico e-mail promemoria excel 2019

Anonimo

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

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.

0 commenti

41 risposte

Anonimo

Ciao Salvatore,

volendo fare un lavoro di razionalizzazione e ottimizzazione del codice, soprattutto per evitare la duplicazione delle righe di codice che seguono distinti cicli per i documenti e i corsi, ho pensato di modificare la routine "CreaEmailScadenze" in questo modo:

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 

   Dim arrTipi As Variant 

   Dim vT As Variant 

   Dim nT As Long 

   Dim sT1 As String, sT2 As String 

   arrTipi = Array("D", "C") 

   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 Each vT In arrTipi 

            Select Case vT 

               Case "D" 

                  nT = NDoc 

                  sT1 = "DATA DI SCADENZA D" 

                  sT2 = "NUMERO D" 

                  sTipoDocCorso = "documento" 

               Case "C" 

                  nT = NCorsi 

                  sT1 = "SCADENZA C" 

                  sT2 = "ULTIMO C" 

                  sTipoDocCorso = "corso" 

            End Select 

               For j = 1 To nT 

                  bSendMail = False 

                  DataScadenza = .ListColumns(sT1 & j).DataBodyRange(i).Value 

                  sNomeDocCorso = .ListColumns(sT2 & j).Range(1).Offset(-1).Value 

                  sCheck = .ListColumns("CHECK " & vT & 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 " & vT & j).DataBodyRange(i).Value = sCheck 

                     End If 

                  End If 

               Next j 

         Next vT 

      Next i 

   End With 

End Sub

Così mi sembra anche più semplice una eventuale modifica del testo dell'oggetto o del corpo dell'email bastando modificare solo una volta.

Se vuoi basta sostituire la routine.

ciao

0 commenti

Anonimo

2024-09-24T09:25:47+00:00

Sì, certo. Ti basta sostituire il codice.
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2024-09-24T09:15:08+00:00

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
La risposta è stata utile?

0 commenti Nessun commento

Anonimo

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

0 commenti

Anonimo

2024-09-23T19:33:13+00:00

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
La risposta è stata utile?

0 commenti Nessun commento