| | 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 [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 |
|
|