Intanto
Benvenuto nel forumNell'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#p647675Le 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...
Registrazione
ringrazio nuovamente tutti per il tempo concesso.