Richiesta aiuto macro VBA

[mara26]

Salve a tutti premetto che sono completamente inesperta di VBA e per questo chiedo il vostro aiuto.
Ho un file di excel con due colonne (S) e (AD) che hanno delle scadenze.
Ho inserito in queste due colonne una formattazione condizionale che mi evidenzia in rosso le date già scadute.
La mia idea era di creare una Macro VBA che mi avvisasse con una mail delle scadenze (tipo il 28 Febbraio mi invia una mail con le scadenze previste per il 31 Marzo).
Nella mail dovrei riportare queste righe

DESCRIZIONE GARA (presente nella Colonna A)
DESCRIZIONE DITTA (presente nella Colonna J)
PROSSIMO PAGAMENTO (presente nella Colonna S e AD) dovrei creare un controllo doppio perchè potrei avere date in colonna S oppure solo in colonna AD oppure in entrambe

Il file si trova su una share condivisa, non ho Outlook che mi invia la mail ma la mail aziendale è su una finestra google.
Ho provato a creare un esempio senza riferimenti particolari. Potreste aiutarmi?

io ho provato così ma non so se è giusto:

Codice: Seleziona tutto

Sub Invioemail()

Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String
Dim BDT As String, I As Long, myCnt As Long               'FIN QUI SONO "DICHIARAZIONI"
'  (a)
Sheets("Foglio1").Select                         '<<< Nome mio Foglio
'compilazione del testo della mail
BDT = "Elenco dei canoni in scadenza al " & Format(Date, "dd-mm-yyyy") & vbCrLf
For I = 2 To ur=range(“A” & rows.count).end(xlup).row
    If IsDate cells(I, "S") and IsDate cells(I, "AD") Then
        If Cells(I, "S") = Date and cells (I, "AD")=Date then
            BDT = BDT & Cells(I, "A") & cells (I, "J")& vbCrLf
            myCnt = myCnt + 1
        End If
    End If
Next I
BDT = BDT & vbCrLf & "Cordiali saluti" & vbCrLf
BDT = BDT & "Macroscadcanoni"
''  (b)
If myCnt = 0 Then Exit Sub                     'Nessuna scadenza, si termina senza azioni
'
'DA QUI CREA E INVIA LA MAIL:
Set OutApp = CreateObject("Outlook.Application")
EmailAddr = "mara@libero.it"                    '<<< INDIRIZZO EMAIL
EmailAddr1 = "mara@gmail.com"                  '<<< INDIRIZZO EMAIL CC
Subj = "Scadenze CANONI del " & Format(Date, "dd-mm-yyyy")       ' OGGETTO DELLA MAIL
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = EmailAddr
.CC = EmailAddr1
.BCC = ""
.Subject = Subj
.Body = BDT
'.Display 'or use .send
.send
End With
'  (c)
Set OutMail = Nothing
'  (d)
Set OutApp = Nothing
'
    Application.Wait (Now + TimeValue("0:00:02"))
End Sub

Grazie in anticipo a quanti vorranno insegnarmi qualcosa

[Anthony47]

Il tuo quesito avrebbe avuto maggiore attenzione se fosse stato pubblicato nella Sezione Applicativi Office; vale per la prossima volta

Se non hai Outlook allora quella automazione andra' in errore sulla riga CreateObject("Outlook.Application"); quindi io cambierei approccio, tenendo presente che, affinche' una segnalazione possa arrivare, il file deve venire aperto.

Propongo pertanto una macro che possa esaminare il contenuto del foglio e riportare su un altro foglio, creato per la circostanza, tutte le righe in scadenza.
Il codice della macro:

Codice: Seleziona tutto

Sub InScad()
Dim wArr, OArr()
Dim I As Long, EarlyW As Long, cSh As Worksheet
Dim J As Long, oInd As Long, Oggi As Date
'
EarlyW = 4                                  '<<< Giorni di notifica anticipata
'
wArr = Range("A1").CurrentRegion.Value
ReDim OArr(1 To UBound(wArr), 1 To UBound(wArr, 2))
'
Oggi = Date
Application.DisplayAlerts = False
Sheets("WARNING_" & Format(Oggi, "yyyy-mm-dd")).Delete
Application.DisplayAlerts = True
'
Sheets("MiaTabella").Select                     '<<< Il foglio con la tabella da analizzare
For I = 2 To UBound(wArr)
    If (wArr(I, 19) - EarlyW) <= Oggi Or (wArr(I, 30) - EarlyW) <= Oggi Then
        oInd = oInd + 1
        For J = 1 To UBound(wArr, 2)
            OArr(oInd, J) = wArr(I, J)
        Next J
    End If
Next I
If oInd > 0 Then
    Set cSh = ActiveSheet
    MsgBox ("Ci sono polizze in scadenza: " & oInd)
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "WARNING_" & Format(Oggi, "yyyy-mm-dd")
    Range("A2").Resize(UBound(OArr), UBound(OArr, 2)).Value = OArr
    cSh.Range("A2").Resize(, UBound(wArr, 2)).Copy
    Range("A2").CurrentRegion.PasteSpecial xlPasteFormats
    cSh.Range("A1").Resize(, UBound(wArr, 2)).Copy Range("A1")
    Range("A1").Select
End If
End Sub

Il codice va inserito in un "Modulo standard" del progetto vba del tuo file; per le informazioni relative, vedi viewtopic.php?f=26&t=103893&p=647675#p647675
Le 2 istruzioni marcate <<< vanno adattate come da commento

Poi all'occorrenza lanci la Sub InScad: le righe della tabella di partenza verrano esaminate, quelle con scadenza saranno copiate in un nuovo foglio accodato ai precedenti il cui nome sara' del tipo "WARNING_2022-05-16" e un messaggio informa dell'esistenza di queste scadenze.
Rieseguendo la macro il foglio di Warning sara' ricreato da zero.
Se non ci sono scadenze ravvicinate non verra' creato nessun foglio di Warning e non ci sara' nessun messaggio

Volendo si puo' fare in modo che la macro vada in esecuzione automaticamente all'apertura del file.
Per questo:
-identifica nel progetto vba del tuo file il modulo chiamato "ThisWorkbook" o "Questa-Cartella_di_Lavoro" e fai doppioclick sul nome
-inserisci questo codice nella pagina che si apre:

Codice: Seleziona tutto

Private Sub Workbook_Open()
Call InScad
End Sub


In questo modo il controllo verra' eseguito automaticamente all'apertura del file; puo' sempre essere fatto lanciando manualmente la Sub InScad; per le modalita' di lancio di una macro vedi viewtopic.php?f=26&t=103893&p=647678#p647678

Prova e fai sapere...