Lavorando sul tuo layout e sul codice che ti avevo segnalato ho prodotto questa macro:
- Codice: Seleziona tutto
Sub Invioemail33BB()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110944
Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim cScad As String, cFree As String, wDays As Long
Dim BDT As String, I As Long, myCnt As Long, Elenco, FogliO 'FIN QUI E' SONO "DICHIARAZIONI"
' (a)
'Parametri
cScad = "G" '<<< La colonna con le date di Scadenza
cFree = "AA" '<<< Una colonna LIBERA
wDays = 11 '<<< I giorni di preavviso desiderati
'
Elenco = Array("Attive") '<<< L'elenco dei fogli in cui cercare
'
BDT = "Elenco Scadenze al " & Format(Date, "yyyy-mmm-dd") & vbCrLf
For Each FogliO In Elenco
BDT = BDT & vbCrLf & "SCADENZE DAL FOGLIO " & FogliO '***
Sheets(FogliO).Select
'compilazione del testo della mail
For I = 3 To Cells(Rows.Count, cScad).End(xlUp).Row
If IsDate(Cells(I, cScad).Value) Then
If Cells(I, cScad) <= (Date + wDays) And Date > Cells(I, cFree) + 7 Then
BDT = BDT & vbCrLf & Cells(I, "B") & " / RdO:" & Cells(I, "E") & " / " & "Scadenza: " & _
Format(Cells(I, cScad), "dd-mmm-yyyy") & " / GG Mancati: " & Cells(I, "H") * (-1) '***
' Cells(I, cFree).Value = Date '??? Risollecito? Vedi Testo
myCnt = myCnt + 1
End If
End If
Next I
Next FogliO
'Si completa il testo della mail:
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf '***
BDT = BDT & "La tua macro" '***
'' (b)
If myCnt = 0 Then
MsgBox ("Nessuna scadenza da segnalare")
Exit Sub 'Nessuna scadenza, si termina senza azioni
End If
'
'DA QUI SI CREA E INVIA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
EmailAddr = "account@dominio.it" '<<< INDIRIZZO EMAIL
Subj = "Scadenze del " & Format(Date, "yyyy-mmm-dd") ' OGGETTO DELLA MAIL
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = EmailAddr
.CC = ""
.BCC = ""
.Subject = Subj
.Body = BDT
.Display ' .Display per "visualizzare" la mail; .send per "Inviare automaticamente"
' .send ' Alternativa a .Display
Beep
End With
MsgBox ("Preparata email con " & myCnt & " scadenze")
Application.Wait (Now + TimeValue("0:00:02"))
' (c)
Set OutMail = Nothing
' (d)
Set OutApp = Nothing
'
End Sub
Va messa all'interno di un "Modulo standard" del tuo vba (vedi
viewtopic.php?f=26&t=103893&p=647675#p647675)Le righe marcate >>> vanno personalizzate come da commento; quelle marcate *** contengono parti del testo della mail che possono essere personalizzate a piacere.
Il codice e' predisposto per creare la mail e visualizzarla pronta per essere spedita, ma a mano; tuttavia eliminando la riga ".Display" e togliendo l' Apostrofo in testa alla riga ".send" si puo' fare in modo che la mail venga spedita direttamente (seguendo le regole di spedizione impostate in Outlook)
Lanciandola, la Sub Invioemail33BB controlla sul foglio "Attive" le scadenze registrate, e per quelle dove i giorni alla scadenza sono inferiori a quanto impostato (o se sono gia' scadute) compila una riga di mail.
La macro continuera' a inviare tutte le scadenze, anche quelle gia' segnalate; se invece si volesse inserire una sospensione alle notifiche, allora si puo' togliere l'apostrofo in testa all'istruzione marcata "??? Risollecito?"; in questo caso allora la data di invio del promemoria di scadenza e' registrata in colonna AA e per i prossimi 7 gg la notifica e' sospesa, per quella riga.
Per avviare la macro, vedi le istruzioni qui:
viewtopic.php?f=26&t=103893&p=647678#p647678Se vuoi fare in modo che la verifica venga fatta automaticamente all'apertura del file, allora devi aggiungere questo codice all'interno del "Modulo di Classe" QuestaCartellaDiLavoro (vedi
viewtopic.php?f=26&t=103893&p=647675#p647675)- Codice: Seleziona tutto
Private Sub Workbook_Open()
Call Invioemail33BB
End Sub
Prova e fai sapere…
PS: hai un messaggio privato