INVIO MAIL 30 GIORNI PRIMA DELLA SCADENZA

[crispy]

buonasera,

volevo sapere se potete aiutarmi a creare un file excel contenente delle scadenze contrattuali, che possa inviare delle email in automatico ai responsabili interessati, 60 giorni e 30 giorni prima della data.

vi ringrazio tantissimo in anticipo!

[alfrimpa]

Crispy allega un file di esempio con i dati non sensibili.

Il file occorre per capire la struttura dei dati

[crispy]

<a href=http://www.filedropper.com/scadenzegruppomacro><img src=http://www.filedropper.com/download_button.png width=127 height=145 border=0/></a><br /><div style=font-size:9px;font-family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;> <a href=http://www.filedropper.com >share files free</a></div>

http://www.filedropper.com/scadenzegruppomacro

[alfrimpa]

Ciao Crispy

Nel file che hai allegato le date presenti in colonna H non sono tali ma testo e pertanto non si possono fare conteggi.

Dovresti riallegarlo con date "effettive"

[crispy]

hai ragione, non ci avevo fatto caso, perchè era un file estratto dal programma paghe.
te lo riallego, grazie mille!
http://www.filedropper.com/scadenzegruppomacro_1

<a href=http://www.filedropper.com/scadenzegruppomacro_1><img src=http://www.filedropper.com/download_button.png width=127 height=145 border=0/></a><br /><div style=font-size:9px;font-family:Arial, Helvetica, sans-serif;width:127px;font-color:#44a854;> <a href=http://www.filedropper.com >online backup storage</a></div>

[alfrimpa]

Un primo inizio potrebbe essere questa macro.

Codice: Seleziona tutto

Sub Inviamail()
    Dim RNG As Range
    Dim CEL As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim bodymail As String
    Dim c As Integer
    Set RNG = Range("h2:h57")
        For Each CEL In RNG
            If CEL.Value - Date = 60 Or CEL.Value - Date = 30 Then
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = CEL.Offset(0, 1).Value
                    .Subject = "SCADENZA" & " " & CEL.Offset(0, -3).Value
                   .Display
                End With
            End If
        Next CEL
End Sub

[crispy]

Grazie mille Alfrimpa! Funziona, mi apre una nuova mail con il nominativo della scadenza nell' oggetto.

Le volevo chiedere se fosse possibile scrivere nel corpo dell' email, il contenuto della colonna F-G e H.
così da non dover rivedere il testo e farle partire in automatico.
Grazie ancora e buona giornata!

[alfrimpa]

Prova con questa

Codice: Seleziona tutto

Sub Inviamail()
    Dim RNG As Range
    Dim CEL As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim bodymail As String
    Dim c As Integer
    Dim testo As String
    Set RNG = Range("h2:h57")
        For Each CEL In RNG
            If CEL.Value - Date = 60 Or CEL.Value - Date = 30 Then
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                testo = "Descrizione_scadenza: " & CEL.Offset(0, -2).Value & Chr(10) & "Possibilità contrattuale: " & CEL.Offset(0, -1).Value & Chr(10) & "Scadenza: " & CEL.Value
                With OutMail
                    .To = CEL.Offset(0, 1).Value
                    .Subject = "SCADENZA" & " " & CEL.Offset(0, -3).Value
                    .Body = testo
                   .Display
                End With
            End If
        Next CEL
End Sub


[Anthony47]

In aggiunta all'ottima macro di Alfredo (vedi sopra), mi permetto di proporre una cosa piu' articolata basata su un paio di considerazioni:
-i contratti potrebbero essere "tanti", i destinatari della mail "alcuni"; inviare tante mail quanti i contratti in scadenza potrebbe risultare confusivo per i riceventi.
-le giornate a -60 e -30 potrebbero essere festive, quindi le mail potrebbero non partire, col confronto Scadenza - Oggi = 60gg oppure 30gg

Quindi io propongo
-di raggruppare in una unica mail per ogni destinatario tutte le sue scadenze
-di utilizzare una colonna di servizio per riportare la data in cui viene inviato il promemoria di prossima scadenza, in modo da spedire il promemoria anche se non fosse stato spedito a -60gg (es perche' festivo).
Il codice complessivo:

Codice: Seleziona tutto

Sub RiepMail()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=108891
Dim OLook As Object
Dim MItem As Object
Dim CScad As Integer, mText As String
Dim MSubj As String, ColScad As String, I As Long, J As Long
Dim clStart As Long, clHead As Long, mCol As String, logCol As String
Dim preAvv As Long, preAvv2 As Long, colBody, Terminator As String
Dim CK As Long, cDest As String, fMex As String, scaMex As String
'
clStart = 2         '<<< La prima riga con dati
clHead = 1          '<<< La riga con le intestazioni
colBody = Array("F", "G", "H")      '<<< Le colonne da riportare nelle mail
ColScad = "H"       '<<< La colonna con le date di scadenza
mCol = "I"          '<<< La colonna con gli indirizzi email
preAvv = 60         '<<< Giorni di primo preavviso
preAvv2 = 30        '<<< Giorni di secondo preavviso
logCol = "L"        '<<< La colonna di servizio in cui si segneranno le mail inviate
MSubj = "Avviso Di Scadenze"    '<<< Il Subject della mail
'
Set OLook = CreateObject("Outlook.Application")
'
For CK = clStart To Cells(Rows.Count, colBody(0)).End(xlUp).Row
    If Application.WorksheetFunction.CountIf(Range(Cells(clStart, mCol), Cells(CK, mCol)), Cells(CK, mCol)) < 2 Then
        cDest = Cells(CK, mCol)
        CScad = 0
        mText = "Elenco delle prossime scadenze: " & vbCrLf
        For I = CK To Cells(Rows.Count, colBody(0)).End(xlUp).Row
            scaMex = ""
            If Cells(I, mCol) = cDest Then
                If (Now + preAvv >= Cells(I, ColScad) Or Now + preAvv2 >= Cells(I, ColScad)) And (Cells(I, logCol).Value + 30) <= Now Then
                    CScad = CScad + 1
                    For J = LBound(colBody) To UBound(colBody)
                        scaMex = scaMex & Cells(I, colBody(J)) & " --- "
                    Next J
                    Cells(I, logCol) = Int(Now)
                    scaMex = scaMex & "Scadenza: " & Format(Cells(I, ColScad), "yyyy-mmm-dd") & vbCrLf & vbLf
                End If
                If Len(mText) > 3 Then mText = mText & scaMex
            End If
        Next I
    Terminator = vbCrLf & "Servizio Automatico di alert" & vbCrLf  '<<< Messaggio di coda
        If CScad > 0 Then
            Set MItem = OLook.createitem(0)
            MItem.To = cDest
            MItem.Subject = MSubj
            MItem.body = mText & vbCrLf & Terminator
            MItem.send
'            MItem.display           'Test only
            Application.Wait (Now + TimeValue("0:00:01"))
            Set MItem = Nothing
            fMex = fMex & vbCrLf & CScad & " scadenze per " & cDest
        End If
    End If
Next CK
If Len(fMex) < 5 Then fMex = "Nessuna scadenza da segnalare"
MsgBox ("Completato: " & vbCrLf & fMex)
Set OLook = Nothing
End Sub


Tutte le righe marcate <<< possono /devono essere modificate per allinearle alla tua situazione.

Ciao

Keyw:
Excel vba macro outlook automation send email before deadline

[ILCUOCO]

SALVE A TUTTI.
Mi aggancio a questa discussione perché avrei bisogno di una mano per un problema simile.
Ho un foglio dati dove, per esempio nelle caselle della colonna D, tramite una sottrazione fra date, presenti in altre caselle, ho un "conto alla rovescia che va da 15 a 0 giorni. Avrei necessita che il sistema inviasse una mail, una volta che si arrivi al giorno 5. Mi spiego meglio la casella riproduce il risultato della sottrazione fra date, quando su questa casella vi è il numero 5 dovrebbe partire la mail verso un singolo indirizzo mail che posso scrivere su una casella qualsiasi (F10) dello stesso foglio.
PER DIRLA TERRA TERRA:
SE D1:D10=5 INVIA MAIL VERSO F10.

SPERO, VISTA LA MIA IGNORANZA, DI ESSERE STATO SUFFICIENTEMENTE CHIARO.
ATTENDO CON ANSIA LE VOSTRE RISPOSTE.
GRAZIE MILLE IN ANTICIPO

[Anthony47]

Per quello che ho capito, questa macro dovrebbe bastare:

Codice: Seleziona tutto

Sub InvioEmail_Scad()
Dim cScad As Long, OLook As Object, mItem As Object, mText As String
'
cScad = Application.WorksheetFunction.CountIf(Range("D1:D10"), 5)
Set OLook = CreateObject("Outlook.Application")
    If cScad > 0 Then
        'Compilazione TEST del messaggio:
        mText = "Buon giorno, sono la tua macro e ti invio questo promemoria" & vbCrLf '<<<
        mText = mText & "Ci sono n° " & cScad & " scadenze tra 5 giorni" & vbCrLf     '<<<
        mText = mText & "Sai cosa fare..."                        '<<<
        Set mItem = OLook.createitem(0)
        mItem.To = Range("F10").Value
        'Compilazione del Subject:
        mItem.Subject = "Mail automatica per boh"                 '<<<
        mItem.body = mText
        mItem.send
'        mItem.display           'Test only
        Application.Wait (Now + TimeValue("0:00:02"))
        Set mItem = Nothing
        Set OLook = Nothing
        MsgBox ("Inviata mail a " & Range("F10"))
    Else
        MsgBox ("Nessuna scadenza da segnalare")
    End If
End Sub

Il testo nelle righe marcate <<< ovviamente e' solo da esempio, metterai quel che serve.

Va messo in un Modulo standard del vba; per questo, partendo da Excel:
-premi Alt-F11 per aprire l'editor delle macro
-Menu /Inserisci /Modulo
-Copia il codice e incollalo nel frame dx del modulo appena creato
Personalizza le righe marcate <<< come detto.

Poi torna su Excel, attiva il foglio che contiene le informazioni e lancia la macro InvioEmail_Scad:
-premi Alt-F8
-seleziona InvioEmail_Scad dall'elenco di macro disponibili
-premi Esegui

Un messaggio informera' sull'esito del controllo.

Ciao, fai sapere.

[ILCUOCO]

GRAZIE MILLE LEGGO SOLO ADESSO, SINCERAMENTE AVEVO ABBANDONATO IL PROGGETTO MA VISTA LA CHIAREZZA DELLA SPIEGAZIONE, LO RIPRENDO SUBITO