Moderatori: Anthony47, Flash30005
Sub SMAIL()
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
MSubj = "Warning su scadenza" '<<<< Subject della mail
MAddr = "aaaaaa@dominio.it" '<<<< Destinatario
Inter = "B4:B50" '<<<< Lista delle celle che saranno controllate per scadenza
'
For Each Scad In Range(Inter)
If Scad < (Int(Now) + 90) Then
CScad = CScad + 1
Mex = Mex & Scad.Row & " / " & Scad.Offset(0, 1).Value & _
Format(Scad.Value, "yyyy-mmm-dd") & vbCrLf
End If
Next Scad
MsgBox ("Ci sono " & CScad & " scadenze inferiori a " & (Int(Now) + 90))
'
If CScad = 0 Then Exit Sub
'
Set OLook = CreateObject("Outlook.Application")
Set MItem = OLook.createitem(0)
MItem.to = MAddr
MItem.Subject = MSubj
MItem.body = "Scadenza voce: riga / voce / data " & vbCrLf & Mex
MItem.send
Application.Wait (Now + TimeValue("0:00:10"))
Set OLook = Nothing
Set MItem = Nothing
End Sub
Mex = Mex & Scad.Row & " / " & Scad.Offset(0, 1).Value & _
Format(Scad.Value, "yyyy-mmm-dd") & vbCrLf
Mex = Mex & Scad.Row & " / " & Scad.Offset(0, -4).Value & _
Format(Scad.Value, "yyyy-mmm-dd") & vbCrLf
Sub SMAILZZ()
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
MSubj = "Warning su scadenza" '<<<< Subject della mail
MAddr = "aaaaaa@dominio.it" '<<<< Destinatario
Inter = "A1:A100" '<<<< Lista delle celle che saranno controllate
ListaF = Array("A", "B", "C") '<<< Elenco Fogli da controllare
For Each LF In ListaF
Sheets(LF).Select
For Each scad In Range(Inter)
If scad <> "" Then
If scad < (Int(Now) + 90) Then
CScad = CScad + 1
Mex = Mex & scad.Row & " / " & scad.Offset(0, 1).Value & _
Format(scad.Value, "yyyy-mmm-dd") & vbCrLf
End If
End If
Next scad
Next LF
'Da qui prosegue la precedente macro:
MsgBox ("Ci sono " & CScad & " scadenze inferiori a " & (Int(Now) + 90))
'
For Each LF In ListaF '<<< Esistente
'AGGIUNTE
If LF = "A" Then
Inter = "A1:A100"
ElseIf LF = "B" Then
Inter = "B1:B100"
ElseIf LF = "C" Then
Inter = "C1:C100"
End If
'Fine Aggiunte
'Continua...
Sub invia_email_Click()
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
foglio = Cells(2, 16).Value
MSubj = "Warning scadenza" & " " & foglio '<<<< Subject della mail
MAddr = "nominativo@gmail.com" '<<<< Destinatario
Inter = "G3:G100" '<<<< Lista delle celle che saranno controllate per scadenza
'
ListaF = Array("Foglio7", "Foglio6") '<<<ElencoFogli da controllare
For Each LF In ListaF
Sheets(LF).Select
If LF = "Foglio7" Then
ListaC = Array("G3:G100", "K3:K100", "O3:O100") '<<< Elenco celle da controllare
For Each LC In ListaC
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
Next LC
ElseIf LF = "Foglio6" 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
End If
Next LF
MsgBox ("Ci sono " & CScad & " righe alla prima scadenza inferiore al " & (Int(Now) + 6) & " del foglio: " & foglio)
'
If CScad > 0 Then
'
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 Sub
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Visitano il forum: Nessuno e 10 ospiti