Mail automatica con confronto data VBA

Question

Ciao a tutti,

Non ho mai programmato in VBA e mi trovo a dover creare una tabella su Excel in cui ho inserito delle scadenze, che si trovano tutte in una colonna (la I per precisione). Il mio problema è che dovrei creare una macro in VBA in cui il programma controlli la data di scadenza riportata nella relativa cella, e 30 giorni prima invii una mail in automatico con l'avviso della scadenza, così come il giorno stesso della scadenza invii una seconda mail con l'avviso.

Vi ringrazio anticipatamente per le risposte.

Fabio

Answer 1

Ciao Fabio,

Ti tingrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 2

Ciao Fabio,

Innanzitutto grazie per la risposta. Ti allego il link del file di esempio: https://1drv.ms/x/s!AnSwbayK6kzWtmqzQctQZh6K9IKK

In primis chiedo chiedo scusa di non aver risposto prima ma ho trascurato il tuo post (:-

Con riferimento al mio file di prova, prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IMper inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim rRiga As Range

    Dim arrIn As Variant

    Dim iCol_Scadenza As Long

    Dim i As Long

    Dim iCol_Avviso1 As Long, iCol_Avviso2 As Long

    Dim LRow As Long

    Const sFoglio As String = "Registro manutenzione"                          '<<=== Modifica

    Const sColonna_Scadenza As String = "G:G"                                      '<<=== Modifica

    Const sColonna_Avviso1 As String = "J:J"                                           '<<=== Modifica

    Const sColonna_Avviso2 As String = "K:K"                                          '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("A2:K" & LRow)

        iCol_Scadenza = .Columns(sColonna_Scadenza).Column

        iCol_Avviso1 = .Columns(sColonna_Avviso1).Column

        iCol_Avviso2 = .Columns(sColonna_Avviso2).Column

    End With

    arrIn = Rng.Value

    For i = 1 To UBound(arrIn)

        Select Case True

        Case IsEmpty(arrIn(i, iCol_Avviso1)) _

             And IsEmpty(arrIn(i, iCol_Avviso2))

            If arrIn(i, iCol_Scadenza) <= DateAdd("m", 1, Date) _

               And arrIn(i, iCol_Scadenza) <= Date Then

                arrIn(i, iCol_Avviso1) = "Sì"

                arrIn(i, iCol_Avviso2) = "Sì"

                Call Invia_Email(arrIn(i, 1))

            ElseIf arrIn(i, iCol_Scadenza) <= DateAdd("m", 1, Date) Then

                arrIn(i, iCol_Avviso1) = "Sì"

                Call Invia_Email(arrIn(i, 1))

            End If

        Case IsEmpty(arrIn(i, iCol_Avviso1))

            If arrIn(1, iCol_Scadenza) <= DateAdd("m", 1, Date) Then

                Call Invia_Email(arrIn(i, 1))

                arrIn(i, iCol_Avviso1) = "Sì"

            End If

        Case IsEmpty(arrIn(i, iCol_Avviso2))

            If arrIn(1, iCol_Scadenza) = Date Then

                Call Invia_Email(arrIn(i, 1))

                arrIn(i, iCol_Avviso2) = "Sì"

            End If

        End Select

        Rng.Value = arrIn

    Next i

End Sub

'--------->>

Public Sub Invia_Email(sMatricola As Variant)

    Dim oMail As Object

    Dim oApp As Object

    Const sDestinatario As String = "******@it.abb.com"       '<<=== Modifica

    Const sOggetto As String = "Avviso scadenza manutenzione"      '<<=== Modifica

    Const sBody As String = "Attenzione, l'apparecchio necessiterà presto di manutenzione, programmare l'intervento."                                                                   '<<=== Modifica                                                        

    Set oApp = CreateObject("Outlook.Application")

    Set oMail = oApp.CreateItem(olMailItem)

    On Error Resume Next

    With oMail

        .To = sDestinatario

        .CC = ""

        .BCC = ""

        .Subject = sOggetto & Space(1) & "Matricola: " & sMatricola

        .Body = sBody

        .SendUsingAccount = oAccount

        .Display

    End With

    On Error GoTo 0

    Set oMail = Nothing

    Set oAccount = Nothing

    Set oApp = Nothing

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<========= 

• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file e incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub Workbook_Open()

    Call Tester

End Sub

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm

Potresti scaricare il mio file di prova Fabio20200523.xlsm

===

Regards,

Norman

Answer 3

Ciao Norman,

nessun problema non ti preoccupare :)

Ho fatto un paio di prove e il codice sembra funzionare a dovere! Non so davvero come ringraziarti!!

Grazie mille e buona giornata!

Fabio

Answer 4

Ciao Fabio,

Non ho mai programmato in VBA e mi trovo a dover creare una tabella su Excel in cui ho inserito delle scadenze, che si trovano tutte in una colonna (la I per precisione). Il mio problema è che dovrei creare una macro in VBA in cui il programma controlli la data di scadenza riportata nella relativa cella, e 30 giorni prima invii una mail in automatico con l'avviso della scadenza, così come il giorno stesso della scadenza invii una seconda mail con l'avviso.

Ti chiederei gentilmente di caricare un file di esempio, dopo averlo depurato dei dati sensibili, su un servizio di condivisione di file, ad esempio Microsoft OneDrive o DropBox, e postare un link al file in una risposta qui.

Per caricare il file su Microsoft OneDrive, vedi:

       Condividere file e cartelle di OneDrive

Nel caso di DropBox, vedi:

Come faccio a condividere file e cartelle in Dropbox?

===

Regards,

Norman

Ciao Norman,

Innanzitutto grazie per la risposta. Ti allego il link del file di esempio: https://1drv.ms/x/s!AnSwbayK6kzWtmqzQctQZh6K9IKK

Grazie e buona giornata,

Fabio

Answer 5

Ciao Fabio,

Non ho mai programmato in VBA e mi trovo a dover creare una tabella su Excel in cui ho inserito delle scadenze, che si trovano tutte in una colonna (la I per precisione). Il mio problema è che dovrei creare una macro in VBA in cui il programma controlli la data di scadenza riportata nella relativa cella, e 30 giorni prima invii una mail in automatico con l'avviso della scadenza, così come il giorno stesso della scadenza invii una seconda mail con l'avviso.

Ti chiederei gentilmente di caricare un file di esempio, dopo averlo depurato dei dati sensibili, su un servizio di condivisione di file, ad esempio Microsoft OneDrive o DropBox, e postare un link al file in una risposta qui.

Per caricare il file su Microsoft OneDrive, vedi:

       Condividere file e cartelle di OneDrive

Nel caso di DropBox, vedi:

Come faccio a condividere file e cartelle in Dropbox?

===

Regards,

Norman