Pagina precedente | 1 2 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Invio email automatico preavviso scadenza certificato medico senza Outlook

Ultimo Aggiornamento: 26/06/2017 09:13
Post: 15
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
24/11/2016 17:59

Invio email automatico preavviso scadenza certificato medico senza Outlook [RISOLTO]
Salve a tutti,
premetto che ancora non sono a conoscenza del vba e avendo cercato sul forum non ho trovato la risposta ad un esigenza simile.
Come da oggetto, avrei bisogno di inviare automaticamente un promemoria di 30 giorni, per la scadenza di certificati medici, di atleti di un impianto sportivo, possibilmente senza l'utilizzo di Outlook ma direttamente dal nostro server (non so se si può scrivere).
Il database è già esistenze e ne allego un immagine dove si possono vedere le colonne interessate.

ps. di alcuni atleti manca l'indirizzo email

[Modificato da fabri1900 27/11/2016 20:53]
Post: 2.445
Registrato il: 21/06/2013
Città: NAPOLI
Età: 70
Utente Veteran
Excel 365
OFFLINE
24/11/2016 19:10

Ciao Fabri

Dovresti, visto che con le immagini non si può far nulla, allegare un file di esempio (così non costringi chi volesse risponderti a doverselo ricostruire da solo)e - soprattutto se non usi Outlook qual è il tuo client di posta.

Alfredo
Post: 2.446
Registrato il: 21/06/2013
Città: NAPOLI
Età: 70
Utente Veteran
Excel 365
OFFLINE
24/11/2016 19:20

Ad esempio questa è una macro che invia mail senza Outlook ma attraverso Aruba.

vb
Sub InviaMail()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim MittenteMail, OggettoMail, DestinatarioMail As String
    
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
 
    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "TuoIndirizzomail"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Tuapassword"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.aruba.it"
 
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'questo solo in caso di problemi
        .Update
    End With
 
    
    strbody = "Avviso di scadenza"
MittenteMail = "TuoIndirizzomail"
DestinatarioMail = "TuoIndirizzomail"
 
    With iMsg
        Set .Configuration = iConf
        .From = MittenteMail
        .To = DestinatarioMail
        .CC = ""
        .BCC = ""
        OggettoMail = "PROVA"
        .From = MittenteMail
        .Subject = OggettoMail
        .TextBody = strbody
        .Send
    End With
 
End Sub

Alfredo
Post: 15
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
24/11/2016 19:32

Ciao alfrimpa!

si tratta proprio di aruba.

ti allego il file completo, ovviamente senza dati sensibili
[Modificato da fabri1900 24/11/2016 19:32]
Post: 2.447
Registrato il: 21/06/2013
Città: NAPOLI
Età: 70
Utente Veteran
Excel 365
OFFLINE
25/11/2016 15:33

Ciao fabri

Ti allego questa macro che purtroppo non ho la possibilità di testare quindi l'ho scritta un po' al buio

vb
Sub InviaMail()
    Dim ur As Long
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim MittenteMail, OggettoMail, DestinatarioMail As String
    Dim rng As Range
    Dim cell As Range
    ur = Worksheets("ELENCO GENERALE").Cells(Rows.Count, "D").End(xlUp).Row
    Set rng = Worksheets("ELENCO GENERALE").Range("D2:D" & ur)
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
  
    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "TuoIndirizzomail"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Tuapassword"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.aruba.it"
  
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'questo solo in caso di problemi
        .Update
    End With
For Each cell In rng
If CInt(Now - cel.Value) + 1 < 30 And cel.Offset(0, 1).Value Like "*@*" Then
     
    strbody = "Avviso scadenza certificato medico"
MittenteMail = "TuoIndirizzomail"
DestinatarioMail = cell.Offset(0, 1).Value
  
    With iMsg
        Set .Configuration = iConf
        .From = MittenteMail
        .To = DestinatarioMail
        .CC = ""
        .BCC = ""
        OggettoMail = "Scadenza certificato medico"
        .From = MittenteMail
        .Subject = OggettoMail
        .TextBody = strbody
        .Send
    End With
    End If
Next cell
  
End Sub


In essa vanno inseriti i parametri (indirizzo mail e password) per il collegamento ad Aruba ed inoltre ti consiglierei di fare qualche prova inserendo come Destinatario mail il tuo indirizzo così puoi verificare se funziona.

Io più di questo non potrei fare perché non ho Aruba.

Alfredo
Post: 16
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
25/11/2016 16:42

Ciao alfrimpa,

ho provato ma mi restituisce l'errore in allegato..


Ti volevo anche dire (Ma forse lo avevi capito e intanto volevi soltanto fare una prova) che il preavviso non dovrà arrivare al mio indirizzo ma a quello di ogni atleta a cui sta scadendo il certificato (colonna E).


Post: 2.449
Registrato il: 21/06/2013
Città: NAPOLI
Età: 70
Utente Veteran
Excel 365
OFFLINE
25/11/2016 17:46

Questa macro l'avevo fatta per un altro utente del forum e nel suo caso, anche lei aveva Aruba, ha funzionato perfettamente.

Io l'ho solo adattato al tuo caso.

Dal messaggio di errore sembrano escludersi errori nella scrittura del codice.

Ma tu hai inserito (nei punti specifici per il collegamento) il tuo indirizzo mail e la password?

Alfredo
Post: 3.474
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
25/11/2016 18:27

Ciao Alfredo, il tuo codice mi da errore sul server, non ho capito perché, questo invece mi funziona (con gmail)
Sub InviaMail()
    Dim ur As Long
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim MittenteMail, OggettoMail, DestinatarioMail As String
    Dim rng As Range
    Dim cell As Range
    ur = Worksheets("ELENCO GENERALE").Cells(Rows.Count, "D").End(xlUp).Row
    Set rng = Worksheets("ELENCO GENERALE").Range("D2:D" & ur)
    Set cdomsg = CreateObject("CDO.message")
    MittenteMail = "tuo indirizzo" '<<<<<<<<<<<<<<<
    OggettoMail = "Scadenza certificato medico"
    With cdomsg.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.aruba.it"
        .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 25 ' <<< controlla se è giusto
    
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = MittenteMail
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"   '<<<<<<<<<<<<< password accesso
        .Update
    End With
    strbody = "Avviso scadenza certificato medico"
    For Each cell In rng
      If (Now + 30) > cell.Value And cell.Offset(0, 1).Value Like "*@*" Then
        DestinatarioMail = cell.Offset(0, 1).Value
        With cdomsg
        .To = DestinatarioMail
        .CC = ""
        .BCC = ""
        .From = MittenteMail
        .Subject = OggettoMail
        .TextBody = strbody
        .Send
        End With
      End If
    Next cell
   
End Sub

[Modificato da patel45 25/11/2016 19:43]

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 17
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
25/11/2016 19:02

Ciao ad entrambi,
ho riprovato ma evidentemente sbaglio ad inserire correttamente le credenziali di accesso.. mi potreste specificare (magari con <<<) dove le devo mettere.

A presto
Post: 2.451
Registrato il: 21/06/2013
Città: NAPOLI
Età: 70
Utente Veteran
Excel 365
OFFLINE
25/11/2016 19:13

Nel codice di patel sono indicate con <<<<<<<<<<<<<

Alfredo
Post: 18
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
25/11/2016 19:37

Scusate ma sono io che sono un po' di legno..

Ho cambiato solo i seguenti ma da lo stesso errore :(

MittenteMail = "tuo indirizzo" '<<<<<<<<<<<<<<<

.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" '<<<<<<<<<<<<< password accesso
Post: 3.475
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
25/11/2016 19:41

io l'ho provata con Gmail, ovviamente cambiando server e porta e funziona, con aruba non posso provare

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 19
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
26/11/2016 23:39

buonasera a tutti,
niente da fare, ho fatto diverse prove, sia con gmail che con aruba ma non va.. sempre stesso errore in allegato

ps. utilizzo excel 2016

ciao ciao
[Modificato da fabri1900 26/11/2016 23:40]
Post: 3.484
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
27/11/2016 08:28

con gmail il server è smtp.gmail.com la porta 587.
Un'altra cosa che non posso provare è excel 2016

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 20
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
27/11/2016 11:02

Buongiorno,
googolando ho trovato in un sito straniero, il seguente codice che almeno con gmail funziona, ora però non riesco ad adattarlo al mio file per l'invio col preavviso di 30 gg agli indirizzi degli atleti..

Sub SendGMail()

' Object creation
Set objMsg = CreateObject("CDO.Message")
Set msgConf = CreateObject("CDO.Configuration")

' Server Configuration
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user@gmail.com"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update

' Email
objMsg.To = "user@gmail.com"
objMsg.From = "fromuser@domain.com"
objMsg.Subject = "Test send with Gmail account"
objMsg.HTMLBody = "HTML/Plain text message."
objMsg.Sender = "Mr. Name"

Set objMsg.Configuration = msgConf

' Send
objMsg.Send

' Clear
Set objMsg = nothing
Set msgConf = nothing

End Sub
Post: 3.485
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
27/11/2016 11:23

come puoi vedere cambia solo la porta, a me funziona 587 e a te 465

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 21
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
27/11/2016 11:31

Ciao,
si infatti,
ho riprovato proprio ora, mettendo la porta 465 sul tuo codice, con gmail e funziona!!
Ce però un altro problemino :(
Ovviamente, per testare, nella colonna E ho inserito il mio indirizzo email e il problema è che mi arrivano un infinità di email, quando invece mi dovrebbero arrivare soltanto quelle degli atleti a cui scade il certificato tra 30 gg e cioè quelle del 27 dicembre e sono soltanto 3.
Post: 3.486
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
27/11/2016 12:49

sostituisci Now con Date
      If (Date + 30) = cell.Value And cell.Offset(0, 1).Value Like "*@*" Then

sul mio pc funzionano ambedue le porte 465 e 587, per Aruba documentati
[Modificato da patel45 27/11/2016 12:54]

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 22
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
27/11/2016 13:35

Okk grande!!
Ti dovrei chiedere gentilmente anche di far comparire nel testo dell'email anche il nome dell'atleta (colonna B)
Post: 3.487
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
27/11/2016 13:42

        .TextBody = "Avviso scadenza certificato medico dell'atleta " & cell.Offset(0, -2).Value

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 23
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
27/11/2016 21:05

Invio email automatico preavviso scadenza certificato medico senza Outlook [RISOLTO]
Ciao patel45,
funziona alla grande almeno con gmail ed ho scoperto che l'errore era dovuto oltre che alla porta anche all' "Accesso per app meno sicure" di google che bisogna attivare dalle impostazioni di sicurezza dell'account.
Per quanto riguarda aruba, non sono riuscito, cercherò di effettuare altre prove..

Ora tramite l' "Application.OnTime", ho impostato l'esecuzione della macro ogni giorno alle ore 15. Mi sapresti indicare la funzione per eseguire una volta a settimana (domenica) alle 11,00?
Post: 421
Registrato il: 16/08/2015
Città: CORDENONS
Età: 67
Utente Senior
Excel 2016-32bit Win11
OFFLINE
27/11/2016 22:02

Un saluto a tutti.

All'avvio della macro puoi inserire questo codice per rilevare il giorno della settimana:
Select Case Application.WorksheetFunction.Weekday(Date, 2)
    Case 7      'esegui se domenica
        MsgBox "oggi è domenica"
        'al posto del MsgBox metti la tua macro ad orario
End Select

______________________________________________________________
C'è chi fa le COSE a CASO e chi fa CASO alle COSE (Ignoto)
Post: 24
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
27/11/2016 22:57

Ciao rollis1300
Appena inserita e sembra che funziona alla grande!

Grazie a te e a tutti.

Buonanotte
Alla prossima
Post: 3.488
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
28/11/2016 12:52

visto che hai risolto potresti allegare il codice completo ?

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 25
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
28/11/2016 13:15

Ciao patel45,
scusa ma non ci ho pensato e non sapevo fosse necessario essendo novizio :)

Allego sia la macro per l'invio email che il Workbook_Open per l'automatizzazione d'invio giornaliero/settimanale.

Ciao a presto

[Modificato da fabri1900 28/11/2016 16:45]
Post: 3.489
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
28/11/2016 16:18

per allega intendevo inseriscile così, è più immediato
Sub MailCertificato_30gg()
    Dim ur As Long
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim MittenteMail, OggettoMail, DestinatarioMail As String
    Dim rng As Range
    Dim cell As Range
    ur = Worksheets("ELENCO GENERALE").Cells(Rows.Count, "D").End(xlUp).Row
    Set rng = Worksheets("ELENCO GENERALE").Range("D2:D" & ur)
    Set cdomsg = CreateObject("CDO.message")
    MittenteMail = "xxxxxxxxxxxx@gmail.com" '<<<<<<<<<<<<<<<
    OggettoMail = "Preavviso di scadenza certificato medico"
    With cdomsg.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 465 ' <<< controlla se è giusto
     
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxxxxxxxx@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxxxx"  '<<<<<<<<<<<<< password accesso
        .Update
    End With
    strbody = ""
    For Each cell In rng
      If (Date + 30) = cell.Value And cell.Offset(0, 1).Value Like "*@*" Then
        DestinatarioMail = cell.Offset(0, 1).Value
        With cdomsg
        .to = DestinatarioMail
        .CC = ""
        .BCC = ""
        .From = MittenteMail
        .Subject = OggettoMail
        .HTMLBody = "Buonasera," & "
" & "
" & _ "Con la presente, le comunichiamo che tra 30 giorni scadrà il certificato medico intestato a " & "" & cell.Offset(0, -2).Value & "" & "." & "
" & _ "Pertanto si consiglia di effettuare al più presto la visita e presentare il nuovo certificato presso il 'Punto Informazioni' dell'impianto." & "
" & "
" & _ "" & "Si ricorda che per l'accesso agli impianti, è necessario essere in regola con le norme sulla tutela sanitaria prevista dalla legge." & "
" & "
" & "
" & _ "" & "" & "Lo staff" & "
" & _ "xxxxxxxxxxxxxxxx" .Send End With End If Next cell End Sub Private Sub Workbook_Open() Application.OnTime TimeValue("15:00"), "MailCertificato_30gg" Select Case Application.WorksheetFunction.Weekday(Date, 2) Case 7 '<<< esegui se domenica Application.OnTime TimeValue("12:00"), "MailCertificato_30gg" End Select End Sub
tanto novizio non mi pare, ha fatto delle buone aggiunte [SM=g27811]
[Modificato da patel45 28/11/2016 16:25]

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 27
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
28/11/2016 17:11

Ciao patel45,
mi spieghi come fate ad allegare in quel modo..

Poi se non ti rompo troppo ti chiedo un altra cosina, prima di inviare il promemoria di 30gg, dovrei inviare l'email anche a tutti gli atleti con certificato già scaduto, quindi da ieri e prima.
Come posso cambiare il:
If (Date + 30) = cell.Value And cell.Offset(0, 1).Value Like "*@*" Then
[Modificato da fabri1900 28/11/2016 17:28]
Post: 3.490
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
28/11/2016 20:24

basta incollare il codice, selezionarlo tutto e cliccare sul pulsante Code

prova con
If Date >= cell.Value And cell.Offset(0, 1).Value Like "*@*" Then

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Post: 28
Registrato il: 13/11/2016
Città: ROMA
Età: 49
Utente Junior
365
OFFLINE
28/11/2016 21:36

Ciao patel45, 

per la correzione certificati scaduti 


Invece non riesco proprio ad allegare come si dvrebbe i codici..
Come mi dicevi, l'ho incollato nel campo messaggio, l'ho selezionato, premuto il pulsante Code, si apre una prima finestra di dialogo, poi una seconda, faccio ok ad entrambe ma come risultato, vengono aggiunti alcuni caratteri e non compare la numerazione di riga.
Ho provato anche usando l'editor ma nulla  

Post: 3.493
Registrato il: 13/03/2012
Città: LIVORNO
Età: 78
Utente Master
2010
OFFLINE
29/11/2016 07:59

basta avere il coraggio di proseguire, la numerazione avviene dopo il tuo invio

----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 2 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 09:33. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com