Invio automatico e-mail promemoria excel 2019

Buongiorno, eccomi qui dopo qualche giorno di test.

Il file funziona lalla grande!

Dato però che non ho grandi nozioni con VBA e sto provando ad imparare di più, sto cercando di apportare modifiche di cui un giorno potrei averne bisogno.

Ad esempio aggiungere un documento, un corso o variare il periodo di avviso di scadenza.

Per quanto riguarda l'aggiunta del documento (o corso) una volta aumentato il numero totale nel codice, dovrei modificare la tabella che VBA utilizza per prelevare i dati, ma non capisco dove sia.

Variando solo il numero complessivo ed aggiungendo le colonne all'interno del foglio di calcolo, mi restituisce un errore.

L'unica cosa da sistemare era la formattazione condizionale.

Ho copiato il nuovo codice nel progetto vba e anche con le modifiche fatte non mi dà errore.

Questo perché non hai modificato il testo delle intestazioni delle colonne interessate.

Ti metto il link al tuo precedente file vuoto con la nuova routine (la vecchia è posizionata alla fine e seguita dal "OLD3"

File vuoto formattato correttamente.xlsm

ciao

Posto un nuovo link perche ho dovuto modificare le colonne. In particolare il numero delle stesse.

Facendo questo, non vorrei che abbia fatto qualcosa di sbagliato.

Adesso invio un nuovo link

https://www.dropbox.com/scl/fi/i93s6w3w6uve4cv0mqkmy/File-vuoto-formattato-correttamente.xlsm?rlkey=6djtmobwwcsawdjnge6j27bfe&st=8oqhhjoh&dl=0

Ciao, hai modificato il codice sul file?

Ho provato a sostituirelo a quello esistente, ma restituisce errore

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