ho creato una macro che mi permetta di mandare automaticamente le mail quando il certificato medico dei miei atleti è in scadenza. Continua a dire: errore run-time 13.
Questa è la parte che non funziona.
- Codice: Seleziona tutto
If Cells(i, 9) - Int(Now) < myScad And (Int(Now) - Cells(i, DataCol)) > Franc Then
Ho forse sbagliato qualcosa?
premetto che nome e cognome sono situati D4 e C4, mentre le mail degli atleti in T4, la data di scadenza dei certificati in I4
Grazie a chiunque vorrà aiutarmi.
- Codice: Seleziona tutto
Sub Inviomailscadenza ()
'Dichiarazioni iniziali:
Dim OutApp As Object, OutMail As Object
Dim EmailAddr As String, Subj As String, DataCol As String, Franc As Long
Dim BDT As String, Nominat As String, mCnt As Long, myScad As Long
' (a)
DataCol = "U"
myScad = 30
Franc = 10
'
Set OutApp = CreateObject("Outlook.Application")
''compilazione di un testo standard di accompagnamento:
BDT = "Buongiorno, con la presente siamo ad informarla che fra 30 giorni il certificato medico di suo/a figlio/a scadrà, si prega di provvedere subito al suo rinnovo." '<<< Testo fisso a piacere
BDT = BDT & vbNewLine & "Cordiali saluti" & vbNewLine
BDT = BDT & "La Segreteria"
'' (b)
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 9) - Int(Now) < myScad And (Int(Now) - Cells(i, DataCol)) > Franc Then
Nominat = Cells(i, 4) & " " & Cells(i, 3) 'Nome Cognome
EmailAddr = Cells(i, 20) 'INDIRIZZO EMAIL
Subj = "Scadenza certificato medico; sig " & Nominat & Format(Cells(i, 9), " dd-mm-yyyy") 'Subj
'
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = EmailAddr
.CC = "info@esperia-torino.it"
.BCC = ""
.Subject = Subj
.Body = BDT
' .Display 'oppure .send
.Send
End With
'' (c)
Application.Wait (Now + TimeValue("0:00:01"))
Set OutMail = Nothing
mCnt = mCnt + 1
Cells(i, DataCol) = Int(Now)
End If
Next i
'
'' (d)
Set OutApp = Nothing
'
Application.Wait (Now + TimeValue("0:00:01"))
If mCnt > 0 Then
MsgBox ("Inviate N. " & mCnt & " mail per prossima scadenza")
Else
MsgBox ("Nessuna scadenza da sollecitare")
End If
'
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub