![](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)
Microsoft 365 e Office | Excel | Per la casa | Windows
Una famiglia di software per fogli di calcolo Microsoft con strumenti per l'analisi, la creazione di grafici e la comunicazione dei dati.
Ciao Salvatore,
Ti metto il link al file con le modifiche fatte al foglio "Pandettamento_Corsi" (l'ho rinominato per mia abitudine senza spazi)
File Invio Email Documenti e Corsi in Scadenza
Come detto ho inserito una "Tabella" che ho nominato "TabellaPandettamentoCorsi"
Abbi pazienza ma ho eliminato gli sfondi colorati nella tabella, mantenendo solo nelle "intestazioni" di riga 1. Con tutti quei colori diventavo strabico :-)
Ho però inserito dei bordi leggeri in generale e quelli un po' più marcati tra una sezione e l'altra.
Se poi nel tuo file definitivo potrai ripristinare i colori.
Ho anche formattato le varie colonne in base al "tipo" (es. Testo e data) verifica se per alcune colonne il formato più opportuno è altro.
Nelle colonne delle date di scadenza ho anche inserito una convalida in modo che si possano inserire solo date (nel caso non vi fosse una data la procedura vba, per la quale per il momento non ho previsto una gestione degli errori, andrebbe in errore VBA).
Per le altre colonne eventualmente valuterai tu se sia opportuno inserire delle eventuali convalide.
Sempre nelle colonne delle date di scadenza ho inserito una formattazione condizionale per verificare per quali date scadenza mancano meno di 6 mesi (nel caso in cui in VBA modificassi i mesi dovresti modificare anche nelle formule della formattazione condizionale il numero di mesi).
Ho anche aggiunto sia per i documenti che per i corsi una colonna per il Check per verificare se l'email è stata inviata.
Le colonne sono a fianco ad ogni sezione. Volendo si potrebbero inserire tutte alla fine, a patto poi di impostare le intestazioni di riga 1 in corrispondenza della prima colonna di ciascuna sezione documento/corso.
Ma credo sia più facilmente comprensibile per ciascuna data di scadenza di ciascuna data quale sia quella per cui è stata inviata una email.
Principalmente il codice VBA si trova nel Modulo1
Ma è presente anche il codice relativo all'evento "doppio click" del foglio con il pandettamento e corsi.
Questo il codice presente nel Modulo1
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 NumeroMesiAvvisoScadenza As Long = 6 '<=== impostare qui il numero di mesi dalla data di scadenza
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 DataAvviso 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 sCheck As String
Dim sTestoOggettoMail As String
Dim sTestoCorpoMail As String
DataAvviso = DateAdd("M", NumeroMesiAvvisoScadenza, Date)
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
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
If DataScadenza <= DataAvviso And sCheck = "" Then
sTestoOggettoMail = sGrado & " " & sCognome & " " & sNome & " - " & _
"Avviso scadenza " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" con data scadenza " & DataScadenza
sTestoCorpoMail = "Egr. " & sGrado & " " & sCognome & " " & sNome & "," & Chr(10) & _
"si avvisa che il " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" è in scadenza con data scadenza " & DataScadenza & "." & String(2, Chr(10)) & _
"Cordiali saluti"
'Debug.Print sTestoCorpoMail 'sGrado, sCognome, DataScadenza, Date, DataScadenza <= DataAvviso, sTipoDocCorso, sNomeDocCorso, sTestoOggettoMail
Call CreaEmailHtml(sEmail, sTestoOggettoMail, sTestoCorpoMail, , , , bInviaEmailAutomaticamente)
.ListColumns("CHECK D" & j).DataBodyRange(i).Value = sStringaCheck
End If
End If
Next j
For j = 1 To NCorsi
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
If DataScadenza <= DataAvviso And sCheck = "" Then
sTestoOggettoMail = sGrado & " " & sCognome & " " & sNome & " - " & _
"Avviso scadenza " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" con data scadenza " & DataScadenza
sTestoCorpoMail = "Egr. " & sGrado & " " & sCognome & " " & sNome & "," & Chr(10) & _
"si avvisa che il " & sTipoDocCorso & " """ & sNomeDocCorso & _
""" è in scadenza con data scadenza " & DataScadenza & "." & String(2, Chr(10)) & _
"Cordiali saluti"
'Debug.Print sTestoCorpoMail 'sGrado, sCognome, DataScadenza, Date, DataScadenza <= DataAvviso, sTipoDocCorso, sNomeDocCorso, sTestoOggettoMail
Call CreaEmailHtml(sEmail, sTestoOggettoMail, sTestoCorpoMail, , , , bInviaEmailAutomaticamente)
.ListColumns("CHECK C" & j).DataBodyRange(i).Value = sStringaCheck
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
Ho dichiarato alcune costanti per consentire una gestione più semplice di eventuali implementazioni (es. il numero di documenti presenti o di corsi).
Se tu volessi cambiare il nome al foglio o alla tabella.
Il numero di mesi per verificare la scadenza del documento.
Il carattere da inserire per il check di email inviata.
In particolare ti segnalo la costante "bInviaEmailAutomaticamente" che se impostata su True fa inviare immediatamente l'email.
In pratica l'email viene compilata, visualizzata un attimo per inserire una eventuale firma preimpostata, e inviata (sempre che nella cella della "POSTA ELETTRONICA" sia presente un indirizzo email. Altrimenti l'email viene solo visualizzata ma non ne viene effettuato l'invio automatico.
La procedura principale è la sub CreaEmailScadenze che effettua un ciclo per tutte le righe della tabella e per le colonne delle date di scadenza dei documenti e corsi.
Se nella cella della data di scadenza trova una data viene effettuata la verifica se la scadenza è entro il termine indicato (6 mesi per come ho impostato il valore della costante "NumeroMesiAvvisoScadenza"), verifica se la relativa colonna Check sia vuota, e nel caso crea l'email (e la invia se la suddetta constante è impostata su true e viene trovato un indirizzo email in corrispondenza della medesima riga).
Sul testo dell'oggetto e del corpo delle email ho impostato un testo "standard".
Se tu volessi un testo differente si tratterebbe di modificare le variabili denominate "sTestoOggettoMail" e "sTestoCorpoMail"
La sub "CreaEmailHtml" è un "modello" standard che normalmente utilizzo per creare delle email andandogli a passare gli argomenti che mi interessano.
Come dicevo ho implementato anche la possibilità di invio singolo con doppio click nella riga del soggetto interessato.
Il codice VBA è presente nel modulo di classe di "Foglio2" (Pandettamento_Corsi) ed è il seguente:
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iSelRow As Long
If Not Intersect(Target, oLoPC.DataBodyRange) Is Nothing Then
Cancel = True
iSelRow = Target.Row - ActiveCell.ListObject.Range.Row
Call CreaEmailScadenze(iSelRow)
End If
End Sub
Se viene effettuato il doppio click un una cella del corpo della tabella individuo la riga dove è stato effettuato il doppio click e passo quel parametro alla solita sub CreaEmailScadenze che esegue, quindi, la procedura di verifica scadenza ed eventuale formazione email per i documenti e corsi del solo soggetto di quella riga.
Ti direi di fare qualche prova inserendo i tuoi dati reali, eventualmente tenendo impostata a False l'opzione di invio automatico delle email per vedere se le email create siano coerenti (senza però intasare la casella di posta dei soggetti per cui fai i test :-D:-D).
Se ci dovessero essere problemi o errori vba fammi sapere in quali situazioni si sono create in modo da replicarli e gestirli.
ciao e buon fine settimana