Scadenziario Excel con email di avviso

[lexer]

Buongiorno a tutti. Inizio ringraziando chi volesse tentare di darmi una mano.
Sono digiuno di programmazione e vi chiedo di essere.
Ho cercato prima di postare ed ho trovato diversi topic simili al mio caso, ma non perfettamente aderenti e non so come comporre le parti di codice che fanno al mio caso.

ho il file excel allegato con
nel diario corsi le scadenze in colonna i
il foglio sorveglianza con le 2 scadenze in colonna N e O

il documento si apre all accensione del pc e vorrei che 1 mese prima della scadenza mi inviasse alla mail in ufficio, una notifica per quanto riguarda i corsi il nome del soggetto, e il corso e per la sorveglianza il nome e cognome con cosa sta per scadere se la visita periodica o per qualche soggetto la rx torace.

Di nuovo grazie a chi mi aiuterà.

https://www.dropbox.com/s/sp1arfvedpeyp ... .xlsm?dl=0

[Anthony47]

Intanto Benvenuto nel forum

Nell'ipotesi che usiate Outlook come software di posta potrebbe funzionare una macro come questa:

Codice: Seleziona tutto

Sub Reminders()
Dim shList, ckList, headList, listList, cScad As Long
Dim I As Long, J As Long, K As Long, TCol As Range
Dim mMess As String, Anticipo As Long, Grace As Long
Dim mySplit1, mySplit2
'
Anticipo = 30               '<<< L'anticipo di notifica, i gg
Grace = 15                  '<<< Sospensione dell'invio, dopo la mail
shList = Array("Diario corsi", "Programma Sorv Sanitaria", "Programma Sorv Sanitaria")
ckList = Array("tblDiarioCorsi,[SCADENZA]", "Tabella1,[PROX]", "Tabella1,[PROX RX]")
listList = Array("[NOME]", "[COGNOME],[NOME]", "[COGNOME],[NOME]")
headList = Array("Corsi in scadenza:", "Medica periodica in scadenza:", "RX in scadenza:")
For I = 0 To UBound(shList)
    mMess = mMess & headList(I) & vbCrLf
    Sheets(shList(I)).Select
    mySplit1 = Split(ckList(I), ",", , vbTextCompare)
    Set TCol = ActiveSheet.Range(mySplit1(0) & mySplit1(1))
    For J = 1 To TCol.Rows.Count
        If Len(TCol.Cells(J, 1).Value) > 3 Then
            If (Date + Anticipo) > TCol.Cells(J, 1) And (Date - Grace) > TCol.Cells(J, 4) Then
                TCol.Cells(J, 4).Value = Date
                cScad = cScad + 1
                mySplit2 = Split(listList(I) & ", ", ",", , vbTextCompare)
                mMess = mMess & Format(TCol.Cells(J, 1), "dd-mmm-yyyy") & ",   "
                For K = 0 To UBound(mySplit2)
                    If Len(mySplit2(K)) > 1 Then
                        mMess = mMess & Range(mySplit1(0) & mySplit2(K)).Cells(J, 1) & ",   "
                    End If
                Next K
                mMess = mMess & vbCrLf
            End If
        End If
    Next J
Next I
Debug.Print mMess
'Messaggio preparato
If cScad > 0 Then
'Ci sono scadenze da comunicare
Dim OutApp As Object, OutMail As Object
'
    Set OutApp = CreateObject("Outlook.Application")
    EmailAddr = "pippo@Dominio.Com"                                 '<<< INDIRIZZO EMAIL
    Subj = "Scadenze prossime del " & Format(Date, "yyyy-mmm-dd")   '<<< OGGETTO DELLA MAIL
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = EmailAddr
        .CC = ""
        .BCC = ""
        .Subject = Subj
        .Body = mMess
    '    .send              '111
        .display            '222
    End With
    Application.Wait (Now + TimeValue("0:00:01"))
    '  (c)
    Set OutMail = Nothing
    '  (d)
    Set OutApp = Nothing
Else
    MsgBox ("Non ci sono eventi in scadenza")
End If
End Sub


Va messa in un "modulo standard del vba"; per questo, partendo da Excel:
-premi Alt-F11 per aprire l'editor delle macro
-Menu /Inserisci /Modulo
-copia il codice e incollalo nel modulo appena creato
Per qualche altra informazione: viewtopic.php?f=26&t=103893&p=647675#p647675

Le righe marcate <<< (sono 4) vanno personalizzate, con:
-il preavviso rispetto alla scadenza con cui vuoi essere informato
-per quanti giorni dopo la prima notifica ulteriori notifiche non vengono piu' inviate anche se la scadenza non e' cambiata
-l'email del destinatario
-il Subject da assegnare alla mail

La macro scansiona i due fogli e crea un messaggio del tipo

Codice: Seleziona tutto

Corsi in scadenza:
29-giu-2023,   c,   
17-set-2023,   a,   
01-lug-2023,   b,   
04-giu-2021,   a,   
01-giu-2021,   a,   
20-nov-2021,   a,   
17-set-2023,   a,   
29-giu-2023,   a,   
Medica periodica in scadenza:
29-lug-2023,   a,   g,   
28-mar-2023,   c,   e,   
17-giu-2023,   d,   d,   
07-nov-2023,   e,   c,   
21-ott-2023,   f,   b,   
RX in scadenza:


(questo elenco e' stato ottenuto impostando un anticipo "abbondante" a 300 gg)

La macro usa le colonne L su DiarioCorsi e Q-R su SorvSanitaria per scrivere la data di invio di un promemoria; un ulteriore promemoria sara' inviato per la stessa scadenza solo dopo il tempo di sospensione indicato prima

La macro, se ci sono scadenze da notificare, crea la mail e la visualizza, pronta per essere spedita; quando sei confidente del risultato allora potresti sostituire il comando Display con Send: per questo elimini la riga marcata 222 e togli l'aopostrofo in testa alla riga marcata 111

Fai sapere...

[Dylan666]

Lo dico per esperienza, questa cosa del PC che parte, apre Excel e manda le e-mail è molto "fragile" nel senso che può andare storta per molti motivi. Non è detto che quando parte Excel ad esempio il PC già navighi, in quel caso niente avvisi. Se nessuno fa partire il computer niente avvisi. Se Excel o il file hanno un problema niente avvisi. Se Outlook ha un problema niente avvisi.

Per tutti questi motivi proverei a spostare il problema su Cloud as esempio su Google;
https://www.alphr.com/set-reminders-google-sheets/

[lexer]

Buongiorno e grazie mille della esaustiva e pronta risposta mi ero dimenticato di scrivere che usavo office 365 for business e Outlook come posta. Tornando alla macro funziona e fa quello che deve, se io volessi che nel messaggio di posta mi inserisse anche il nome del corso relativo all utente dove aggiungo il comando nella macro?
Grazie

[Anthony47]

Aggiungere il nome del corso e' semplice, ma non te lo descrivo perche' l'approccio utilizzato e' sbagliato, in particolare scrivere la data di invio del reminder in una colonna fuori dalla tabella dati: la tabella infatti e' una entita' dati autonoma, quindi ad esempio puoi spostarla, aggiungere righe o colonne, ordinare i dati a piacere (esempio per data di scadenza del documento), e ognuna di queste operazioni puo' creare un disallineamento "mortale" con le colonne esterna.
Se vogliamo tenere traccia degli invii (e io suggerisco che lo si debba fare) allora dobbiamo inserire una colonna apposita nelle tabelle; questo richiede tempo e potro' descrivertelo meglio solo piu' tardi in pomeriggio.

Intanto ti suggerisco di non sottovalutare le osservazioni di Dylan

[Anthony47]

Ti avevo anticipato della necessita' di modificare le tabelle per inserire in quelle interessate le colonne per registrare la data di invio di un "reminder" relativo a quella riga; e di conseguenza la necessita' di adattare la macro alla nuova struttura, oltre all'aggiunta del nome corso sul testo di remind.

A) Modifica Tabelle
1) Sul foglio DiarioCorsi aggiungi una colonna alla tabella; puo' essere in qualsiasi posizione, ma credo che sia meglio aggiungerla in fondo a destra. Intesta questa colonna "Log" (puoi intestarla come vuoi, l'importante e' che nel codice usi la stessa intestazione)
2) Sul foglio ProgrammaSorvSanitaria aggiungi due colonne, e intestale "Log1" e "LogRx" (stesse considerazioni fatte al punto 1)

B) Modifica Macro
1) ho corretto la lista dei campi da esportare nella mail (aggiunta NomeCorso); vedi riga listList = Array("[NOME],[CORSO]", etc etc
2) ho dichiarato le posizioni in cui registrare le date di invio remind; vedi riga logPos = Array("[Log]", "[Log1]", "[LogRx]") (se hai intestato le colonne in modo diverso da quanto ho suggerito allora devi modificare questa riga)
3) ho adattato la macro alla nuova struttura dati
4) ho fatto una ulteriore modifica al contenuto del messaggio per renderlo (forse) piu' leggibile

Il codice complessivo, che sostituisce il precedente:

Codice: Seleziona tutto

Sub Reminders2()
Dim shList, ckList, headList, listList, cScad As Long
Dim I As Long, J As Long, K As Long, TCol As Range
Dim mMess As String, Anticipo As Long, Grace As Long
Dim mySplit1, mySplit2
Dim logPos, dtPos As Range
'
Anticipo = 30               '<<< L'anticipo di notifica, i gg
Grace = 15                  '<<< Sospensione dell'invio, dopo la mail
'Descrizioni:
shList = Array("Diario corsi", "Programma Sorv Sanitaria", "Programma Sorv Sanitaria")      'Elenco fogli da processare
ckList = Array("tblDiarioCorsi,[SCADENZA]", "Tabella1,[PROX]", "Tabella1,[PROX RX]")        'Elenco tabelle e colonne data da esaminare
listList = Array("[NOME],[CORSO]", "[COGNOME],[NOME]", "[COGNOME],[NOME]")                  'Elenco campi da riportare
headList = Array("Corsi in scadenza:", "Medica periodica in scadenza:", "RX in scadenza:")  'Intestazioni su mail
logPos = Array("[Log]", "[Log1]", "[LogRx]")
'
For I = 0 To UBound(shList)
    If I > 0 Then mMess = mMess & "------" & vbCrLf
    mMess = mMess & headList(I) & vbCrLf
    Sheets(shList(I)).Select
    mySplit1 = Split(ckList(I), ",", , vbTextCompare)
    Set TCol = ActiveSheet.Range(mySplit1(0) & mySplit1(1))
    For J = 1 To TCol.Rows.Count
        If Len(TCol.Cells(J, 1).Value) > 3 Then
            Set dtPos = Range(mySplit1(0) & logPos(I)).Cells(J, 1)
            If (Date + Anticipo) > TCol.Cells(J, 1) And (Date - Grace) > dtPos.Value Then
                dtPos.Value = Date
                cScad = cScad + 1
                mySplit2 = Split(listList(I) & ", ", ",", , vbTextCompare)
                mMess = mMess & Format(TCol.Cells(J, 1), "dd-mmm-yyyy") & ",   "
                For K = 0 To UBound(mySplit2)
                    If Len(mySplit2(K)) > 1 Then
                        mMess = mMess & Range(mySplit1(0) & mySplit2(K)).Cells(J, 1) & ",   "
                    End If
                Next K
                mMess = mMess & vbCrLf
            End If
        End If
    Next J
Next I
mMess = mMess & "------"
Debug.Print mMess
'Messaggio preparato
If cScad > 0 Then
'Ci sono scadenze da comunicare
Dim OutApp As Object, OutMail As Object
'
    Set OutApp = CreateObject("Outlook.Application")
    EmailAddr = "pippo@Dominio.Com"                                 '<<< INDIRIZZO EMAIL
    Subj = "Scadenze prossime del " & Format(Date, "yyyy-mmm-dd")   '<<< OGGETTO DELLA MAIL
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = EmailAddr
        .CC = ""
        .BCC = ""
        .Subject = Subj
        .Body = mMess
    '    .send
        .display
    End With
    Application.Wait (Now + TimeValue("0:00:01"))
    '  (c)
    Set OutMail = Nothing
    '  (d)
    Set OutApp = Nothing
Else
    MsgBox ("Non ci sono eventi in scadenza")
End If
End Sub


Eseguendo questa macro sul file da te pubblicato si ottiene, avendo impostato un Anticipo=300 gg, questo elenco:

Codice: Seleziona tutto

Corsi in scadenza:
29-giu-2023,   c,   RSPP,   
17-set-2023,   a,   PRIMO SOCCORSO,   
01-lug-2023,   b,   ANTINCENDIO,   
04-giu-2021,   a,   USO CARRELLI INDUSTRIALI,   
01-giu-2021,   a,   RESPONSABILE_GESTIONE RIFIUTI_1_2_4,   
20-nov-2021,   a,   RESPONSABILE_GESTIONE RIFIUTI_3_5,   
17-set-2023,   a,   PRIMO SOCCORSO,   
29-giu-2023,   a,   RSPP,   
------
Medica periodica in scadenza:
29-lug-2023,   a,   g,   
28-mar-2023,   c,   e,   
17-giu-2023,   d,   d,   
07-nov-2023,   e,   c,   
21-ott-2023,   f,   b,   
------
RX in scadenza:
------


(L'impostazione a 30 gg con quei dati provoca solo il report di 3 corsi scaduti nel 2021)

Prova e fai sapere...

[Anthony47]

Aggiungo:
Avendo tu Office 365 è "un attimo" creare le tabelle di scadenza con formule. Ad esempio:
Aggiungi un foglio che chiamiamo Reminder (il nome non e' importante)
-usa le seguenti formule:
in B3

Codice: Seleziona tutto

=LET(Scadenze;tblDiarioCorsi[SCADENZA];Anticipo;A2;myCols;STACK.ORIZ(Scadenze;tblDiarioCorsi[NOME];tblDiarioCorsi[CORSO]);fList;FILTRO(myCols;((OGGI()+Anticipo)>Scadenze)*(Scadenze>0);"");fList)

In F3

Codice: Seleziona tutto

=LET(Scadenze;Tabella1[PROX];Anticipo;E2;myCols;STACK.ORIZ(Scadenze;Tabella1[COGNOME];Tabella1[NOME]);fList;FILTRO(myCols;((OGGI()+Anticipo)>Scadenze)*(Scadenze>0);"");fList)


In J3

Codice: Seleziona tutto

=LET(Scadenze;Tabella1[PROX RX];Anticipo;I2;myCols;STACK.ORIZ(Scadenze;Tabella1[COGNOME];Tabella1[NOME]);fList;FILTRO(myCols;((OGGI()+Anticipo)>Scadenze)*(Scadenze>0);"");fList)

In A2, E2 e I2 inserisci i giorni di Anticipo con cui vuoi vedere le scadenze
In B2, F2 e J2 inserisci le intestazioni che preferisci

Il risultato e' come da immagine, ottenuto con degli Anticipi di fantasia:

[lexer]

Grazie a tutti. Funziona tutto correttamente. ho impostato anche un foglio con le formule come suggerito e compilato il reminder di google non si sa mai ringrazio nuovamente tutti per il tempo concesso.