Ciao eliorimnap, benvenuto nel forum.
Allora partiamo da una delle tante Sub Iviaemail che abbiamo pubblicato, ad esempio in questa discussione:
viewtopic.php?f=26&t=104487Va adattata per scansionare un elenco di fogli, testare il contenuto di colonna M e per aggiungere in una colonna libera la data di invio mail (servira' per evitare di inviare una nuova email per lo stesso motivo nei prossimi 15 giorni, se lo status rimane SCAD); per quest'ultimo scopo io ho usato la colonna Z, se non fosse libera bisogna adattare leggermente il codice.
Ho assunto che il nome del foglio indichi direttamente il nome del Mezzo, da usare nella composizione del messaggio; quindi ho previsto nella macro una istruzione che riepiloghera' quali fogli sono da ispezionare
Il codice risultante:
- Codice: Seleziona tutto
Sub Invioemail()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=105944
''Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=104487
Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String, myShips, Ship
Dim BDT As String, I As Long, myCnt As Long 'FIN QUI SONO "DICHIARAZIONI"
' (a)
'compilazione del testo della mail
BDT = "Elenco delle Visite in scadenza al " & Format(Date, "yyyy-mmm-dd") & vbCrLf
myShips = Array("Nave1", "Nave2") '<<< Elenco dei fogli da esaminare
For Each Ship In myShips
Sheets(Ship).Select
For I = 2 To Cells(Rows.Count, "M").End(xlUp).Row
If UCase(Left(Cells(I, "M").Value, 4)) = "SCAD" Then
If Cells(I, "Z") + 15 < Date Then
Cells(I, "Z").Value = Date
BDT = BDT & ActiveSheet.Name & " - " & Range("M4").Value & " - " & Cells(I, "A") & _
" - Scadenza: " & Format(Cells(I, "H").Value, "dd-mmm-yyyy") & vbCrLf
myCnt = myCnt + 1
End If
End If
Next I
BDT = BDT & vbCrLf
Next Ship
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf
BDT = BDT & "La tua macro"
'' (b)
If myCnt = 0 Then Exit Sub 'Nessuna scadenza, si termina senza azioni
'
'DA QUI SI CREA E INVIA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
EmailAddr = "TuaEmail@Dominio.ppp" '<<< 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 'or use .send
.send '*** Vedi testo
End With
' (c)
Set OutMail = Nothing
' (d)
Set OutApp = Nothing
'
Application.Wait (Now + TimeValue("0:00:02"))
End Sub
Va inserito in un "Modulo standard" del vba:
-dal tuo foglio excel, premi Alt-F11 per aprire l' editor delle macro
-Menu /Inserisci /Modulo
-copia il codice e inseriscilo nel frame di dx
Le istruzioni marcate <<< vanno personalizzate come da commento sulla linea.
Nota***: non so quale versione di Outlook usi, per cui non so come si comportera' sull'istruzione ".send"; con OL2010 o superiori la mail viene inviata; con OL2003 e inferiori esce un avviso che richiede l'intervento dell'operatore per confermare l'invio; OL2007 non so a quale gruppo appartiene.
La macro inviera' una sola mail riepilogativa delle scadenze rilevate su tutti i fogli; se non ci sono scadenze non verra' inviata nessuna mail.
Una scadenza corrisponde allo status SCAD in colonna M con nessuna data in colonna Z, o comunque con una data inferiore a "15 giorni fa".
Ciao, fai sapere.