Risultati da 1 a 4 di 4

Discussione: Creazione scadenzario con avviso via mail



  1. #1
    L'avatar di fra.mani
    Clicca e Apri
    Data Registrazione
    Jun 2016
    Località
    Roma
    Messaggi
    2
    Versione Office
    Excel 2013
    Likes ricevuti
    0
    Likes dati
    0

    Creazione scadenzario con avviso via mail

    Salve,
    sto cercando di creare uno scadenzario con excel che mi avvisi automaticamente con una mail quando una certa cosa è in scadenza.

    Ho creato delle macro per estrarre i nomi dei file da alcune cartelle, tramite formula ho estratto la data scritta nei nomi dei file.

    Adesso vorrei creare un sistema che mi avvisi tramite mail quando una data si avvicina ad una settimana da oggi o ad un mese da oggi.

    Ad. esempio legge le date della colonna (H) delle assicurazioni e se manca meno di una settimana da oggi mi invia mail con nome casella adiacente in colonna (F);
    poi legge le date della colonna (K) dei corsi di formazione e se manca meno di mese da oggi mi invia mail con nome casella adiacente in colonna (I).

    Di seguito le macro attive:

    Codice: 
    Sub EleFile()
    Dim riga As Integer, fs As String
    miapath = "C:\Users\Utente\Desktop\Assicurazioni\"
    ChDir miapath
    riga = 2
    Columns("A:A").ClearContents
    fs = Dir("*.*")
    If fs = "" Then Exit Sub
    While fs <> ""
    riga = riga + 1
    Cells(riga, 1) = fs
    fs = Dir
    Wend
    End Sub
    Sub EleFile2()
    Dim riga As Integer, fs As String
    miapath = "C:\Users\Utente\Desktop\prova\"
    ChDir miapath
    riga = 2
    Columns("B:B").ClearContents
    fs = Dir("*.*")
    If fs = "" Then Exit Sub
    While fs <> ""
    riga = riga + 1
    Cells(riga, 2) = fs
    fs = Dir
    Wend
    End Sub
    
    
    Sub tuttemacro()
    Call EleFile
    Call EleFile2
    End Sub
    Sub Auto_open()
    Call EleFile
    Call EleFile2
    End Sub
    Premetto che tramite Solway's Task Scheduler ho programmato l'avvio del file automatico ogni giorno e all'apertura si eseguono le macro

    Grazie molte

    ----------Post unito in automatico----------

    Se possibile il servizio di invio mail da configurare con account gmail non deve essere Outlook sto provando questo senza successo:

    Codice: 
    Sub invia_email_CDO()
    
    Set mess = CreateObject("CDO.Message")
    Set config = CreateObject("CDO.Configuration")
    
    
    config.Load -1 ' CDO Source Defaults
    config.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    config.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
    = "smtp.gmail.com" 'metti qui il tuo server smtp
    
    
    'Type of authentication, NONE, Basic (Base64 encoded), NTLM
    config.Fields.Item("schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    
    
    'Your UserID on the SMTP server
    config.Fields.Item("schemas.microsoft.com/cdo/configuration/sendusername") = "miserveunemail@gmail.com"
    
    
    'Your password on the SMTP server
    config.Fields.Item("schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
    
    
    
    
    config.Fields.Item("schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    config.Fields.Update
    
    
    With mess
    Set .Configuration = config
    .To = Range("M3").Value
    .CC = ""
    .BCC = ""
    .From = "miserveunemail@gmail.com"
    .Subject = Range("A3").Value
    .TextBody = Range("F3").Value
    '.AddAttachment PercorsoAssolutoFileDaAllegare
    End With
    
    
    mess.Send
    
    
    End Sub
    Ultima modifica fatta da:cromagno; 28/06/16 alle 07:29 Motivo: Inserito codice tra i tag CODE...

  2. #2

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Creazione scadenzario con avviso via mail

    Sarebbe più facile aiutarti se avessi allegato in file senza dati sensibili.
    Ho cercato di interpretare i campi del tuo file e ho scritto questa routine che cicla la colonna H e in scadenza (7 giorni) invia una mail dalla colonna M con oggetto in A e corpo in F.

    Codice: 
    Sub RicercaInScadenza()
    Dim uRiga As Long
    Dim iCount As Long
    
    
    uRiga = Range("h" & Rows.Count).End(xlUp).Row
    
    
    For iCount = 3 To uRiga
        If Range("H" & iCount) > Date - 7 Then
            Range("H" & iCount).Select
            Call Invia_email_CDO(Range("M" & iCount), Range("A" & iCount), Range("F" & iCount))
        End If
    Next
    
    
    End Sub
    
    
    Sub Invia_email_CDO(StrTo As String, strSubject As String, strTextBody As String)
    Dim Mess As Object
    Dim Config As Object
    Dim SMTP_Config As Variant
    
    
    Set Mess = CreateObject("CDO.Message")
    On Error GoTo Error_Handling
    
    
    Set Config = CreateObject("CDO.Configuration")
    
    
    Config.Load -1 ' CDO Source Defaults
    
    
    Set SMTP_Config = Config.Fields
    
    
    With SMTP_Config
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'metti qui il tuo server smtp
        'Type of authentication, NONE, Basic (Base64 encoded), NTLM
        .Item("schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Your UserID on the SMTP server
        .Item("schemas.microsoft.com/cdo/configuration/sendusername") = "miserveunemail@gmail.com"
        'Your password on the SMTP server
        .Item("schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
        .Item("schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With
    
    
    With Mess
        Set .Configuration = Config
        .To = StrTo 'Range("M3").Value
        .CC = ""
        .BCC = ""
        .From = "miserveunemail@gmail.com"
        .Subject = strSubject 'Range("A3").Value
        .TextBody = strTextBody 'Range("F3").Value
        '.AddAttachment PercorsoAssolutoFileDaAllegare
        .Send
    End With
    
    
    Error_Handling:
    
    
    If Err.Description <> "" Then MsgBox Err.Description
    
    
    Set Mess = Nothing
    Set Config = Nothing
    Set SMTP_Config = Nothing
    End Sub
    P.S. E' gradita una presentazione qui

  3. I seguenti utenti hanno dato un "Like"


  4. #3
    L'avatar di fra.mani
    Clicca e Apri
    Data Registrazione
    Jun 2016
    Località
    Roma
    Messaggi
    2
    Versione Office
    Excel 2013
    Likes ricevuti
    0
    Likes dati
    0

    Re: Creazione scadenzario con avviso via mail

    Ho trovato questa (tramite Outlook) e funziona, soltanto che vorrei poter inserire nell'oggetto il testo scritto nella cella adiacente a quella in scadenza, al momento ho solo nel corpo del messaggio il valore della scadenza:

    Codice: 
    Private Sub Workbook_Open()
    Dim OLook As Object 'Outlook.Application
    Dim MItem As Object 'Outlook.MailItem
    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 = "xxxx@gmail.com"
    Inter = "H3:H100" '<<<< Lista delle celle che saranno controllate per scadenza
    ListaF = Array("Foglio1") '<<<Elenco Fogli da controllare
    For Each LF In ListaF
    Sheets(LF).Select
    If LF = "Foglio1" Then
    ListaC = Array("H3:H100") '<<< Elenco celle da controllare
    For Each LC In ListaC
    NScad = NScad + 1
    For Each scad In Range(LC)
    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
    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
    
    End If
    Next LF
    End Sub
    ----------Post unito in automatico----------

    Ho modificato un po questo e funziona bene, l'unico problema è dover cliccare sul MsgBox per poter fa partire le mail:

    Codice: 
    Private Sub Workbook_Open()
    Dim OLook As Object 'Outlook.Application
    Dim MItem As Object 'Outlook.MailItem
    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 = "xxxxxx@gmail.com"
    Inter = "H3:H100" '<<<< Lista delle celle che saranno controllate per scadenza
    ListaF = Array("Foglio1") '<<<Elenco Fogli da controllare
    For Each LF In ListaF
    Sheets(LF).Select
    If LF = "Foglio1" Then
    ListaC = Array("H3:H100") '<<< Elenco celle da controllare
    For Each LC In ListaC
    NScad = NScad + 1
    For Each scad In Range(LC)
    If scad <= (Int(Now) + 6) And scad >= Int(Now) Then
    CScad = CScad + 1
    Mex = Mex & scad.Row & " / " & scad.Offset(0, -2).Value & " " & " Data " & NScad & "° scad. : " & Format(scad.Value, "dd/mm/yyyy") & vbCrLf
    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 in Arrivo" '<<<< Subject della mail
    Set OLook = CreateObject("Outlook.Application")
    Set MItem = OLook.createitem(0)
    MItem.To = MAddr
    MItem.Subject = MSubj
    MItem.body = Mex
    MItem.Send
    Mex = ""
    Application.Wait (Now + TimeValue("0:00:10"))
    Set OLook = Nothing
    Set MItem = Nothing
    End If
    Next LC
    
    End If
    Next LF
    End Sub
    Ultima modifica fatta da:cromagno; 28/06/16 alle 07:30 Motivo: Inserito codice tra i tag CODE...

  5. #4

    L'avatar di Rubik72
    Clicca e Apri
    Data Registrazione
    Dec 2015
    Località
    Cosenza
    Età
    45
    Messaggi
    2833
    Versione Office
    Excel 2013
    Likes ricevuti
    1027
    Likes dati
    983

    Re: Creazione scadenzario con avviso via mail

    Ma la routine nel post #2 ti funziona?

Discussioni Simili

  1. gestione scadenzario e appuntamenti
    Di livio1982 nel forum Domande su Excel in generale
    Risposte: 5
    Ultimo Messaggio: 06/02/17, 21:35
  2. Avviso scadenze con mail
    Di givi79 nel forum Domande su Excel VBA e MACRO
    Risposte: 2
    Ultimo Messaggio: 27/12/16, 21:39
  3. Invio mail con allegato da excel ( Body mail = mail salvata + aggiuta testo)
    Di Ludovico nel forum Domande su Excel VBA e MACRO
    Risposte: 1
    Ultimo Messaggio: 22/12/16, 11:13
  4. Risposte: 9
    Ultimo Messaggio: 20/11/16, 16:54
  5. Scadenzario elettorale
    Di totorom1 nel forum Domande su Excel VBA e MACRO
    Risposte: 5
    Ultimo Messaggio: 22/02/16, 23:11

Tag per Questa Discussione

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •