Ciao, ecco la procedura perfettamente funzionante.
Sicuramente si potrà ottimizzare e migliorare
, ma per quello che serve a me è OTTIMA così
- Codice: Seleziona tutto
Private Sub Workbook_Open()
Dim OLook As Object 'Outlook.Application
Dim MItem As Object 'Outlook.MailItem
'Dim FSend As Boolean 'Flag "Send"
Dim Inter As String, CScad As Integer
Dim MAddr As String, MSubj As String
Dim foglio As String, NScad As Integer
foglio = Cells(2, 16).Value
MAddr = "aaaaaaa@gmail.com" '<<<< Destinatario
Inter = "G3:G100" '<<<< Lista delle celle che saranno controllate per scadenza
'
ListaF = Array("Per Cantiere", "Scadenze Preventivi") '<<<ElencoFogli da controllare
For Each LF In ListaF
Sheets(LF).Select
If LF = "Per Cantiere" Then
ListaC = Array("G3:G100", "K3:K100", "O3:O100") '<<< Elenco celle da controllare
For Each LC In ListaC
NScad = NScad + 1
For Each scad In Range(LC)
'If scad <> "" Then
If scad <= (Int(Now) + 6) And scad >= Int(Now) Then
CScad = CScad + 1
Mex = Mex & scad.Row & " / " & scad.Offset(0, -3).Value & " " & " Data " & NScad & "° scad. : " & Format(scad.Value, "dd/mm/yyyy") & vbCrLf
'End If
End If
Next scad
MsgBox ("Ci sono " & CScad & " righe alla " & NScad & " ° scadenza inferiore al " & (Int(Now) + 6) & " del foglio: " & LF)
'
If CScad > 0 Then
'
CScad = 0
MSubj = "Warning scadenza" & " " & LF '<<<< Subject della mail
Set OLook = CreateObject("Outlook.Application")
Set MItem = OLook.createitem(0)
MItem.to = MAddr
MItem.Subject = MSubj
MItem.body = "Scadenza voce: riga / Cliente / data " & vbCrLf & Mex
MItem.send
Mex = ""
Application.Wait (Now + TimeValue("0:00:10"))
Set OLook = Nothing
Set MItem = Nothing
End If
Next LC
ElseIf LF = "Scadenze Preventivi" Then
Inter = "G3:G100"
For Each scad In Range(Inter)
'If scad <> "" Then
If scad <= (Int(Now) + 6) And scad >= Int(Now) Then
CScad = CScad + 1
Mex = Mex & scad.Row & " / " & scad.Offset(0, -3).Value & " " & " Data prima scad. : " & Format(scad.Value, "dd/mm/yyyy") & vbCrLf
'End If
End If
Next scad
MsgBox ("Ci sono " & CScad & " righe alla prima scadenza inferiore al " & (Int(Now) + 6) & " del foglio: " & LF)
'
If CScad > 0 Then
'
MSubj = "Warning scadenza" & " " & LF '<<<< Subject della mail
Set OLook = CreateObject("Outlook.Application")
Set MItem = OLook.createitem(0)
MItem.to = MAddr
MItem.Subject = MSubj
MItem.body = "Scadenza voce: riga / Cliente / data " & vbCrLf & Mex
MItem.send
Application.Wait (Now + TimeValue("0:00:10"))
Set OLook = Nothing
Set MItem = Nothing
End If
End If
Next LF
End Sub
Anche se dal codice è evidente, Spiego brevemente quello che fa la procedura:
come si esegue la procedura controlla due diversi fogli di lavoro dove ci sono delle diverse colonne che riportano delle date di scadenza.
1) Controlla le scadenze e memorizza quale sono le date in scadenza
2) mostra un messaggio a video indifferentemente sia che vi siano scadenze o no per ogni colonna che controlla di ogni relativo foglio di lavoro.
3) Se ci delel scadenze invia un email riportando nel corpo dell'email quale sono le date in scadenza la riga e il nome del cliente associato alla data.
Nel Dettaglio la procedura controlla nel foglio Per cantere controllando le colonne G3:G100, O3:O100, e K3:100
per ogni colonna che controlla si memorizza quante sono le scadenze e mostra un messaggio a video indifferentemente se ci siano o no scadenze e invia un email se le scadenze sono maggiori di 0. Quindi se per ogni colonna ci sono almeno una scadenza inviera tre email contenente in ogni email la data di scadenza la riga a cui si riferisce e il nome del cliente associato a tale data per ogni scadenza trovata.
Dopo di ciò passa al foglio Scadenze preventivi e fa la medesima cosa con la differenza che nel foglio Scadenze preventivi la colonna da controllare per le scadenze è solo la G3:G100
Spero di essere stato chiaro
A buon Rendere a tutti