Come ti ho detto, sei principalmente tu con quella istruzione che attende 10-20 secondi per ogni mail che blocchi il pc e crei quella situazione insostenibile. Non so a che cosa ti serve, e nemmeno capisco a cosa dovrebbe servirti l'OnTime.
Io, dopo un .Send o .Display raccomando di inserire una piccola attesa per essere certi che la mail passi nella coda di gestione di Outlook prima che la macro Excel la distrugga; purtroppo con Application.Wait la granularita' e' a blocchi di 1 secondo, quindi il minimo possibile con quella istruzione e' 1 secondo anche se dalle mie prove potrebbe bastare anche meno.
Comunque, se dopo aver impostato l'attesa su 1 secondo ancora vuoi spedire un tot di mail al giorno allora:
-usiamo colonna Z per marcare la data di spedizione
-modifichiamo il codice che hai pubblicato come segue:
- Codice: Seleziona tutto
Dim EmailAddr As String
Dim Subj As String
Dim StrMsg As String
Dim uR As Long
Dim I As Long
Dim OutApp As Object
Dim OutMail As Object
'Fin qui sono istruzioni gia' presenti
'
'Segue Codice modificato da Forum:
Sheets("Sheet1").Select '<<< Il foglio con gli indirizzi
FreeCol = "Z" '<<< La colonna in cui scriveremo la data di spediziione
MailPerDay = 10 '<<< Quante ne vuoi spedire ogni volta
Set OutApp = CreateObject("Outlook.Application")
uR = Cells(Rows.Count, 4).End(xlUp).Row
For I = 2 To uR
If Cells(I, FreeCol) = "" Then
destinatario = Range("D" & I)
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = destinatario
.Subject = "PROVA"
.HTMLBody = StrMsg
.Attachments.Add ("C:\Users\...\document.pdf")
.Attachments.Add ("C:\Users\....\cartel1.zip")
.Display
'.Send
Application.Wait (Now + TimeValue("0:00:01"))
End With
Cells(I, FreeCol) = CDate(Int(Now))
Set OutMail = Nothing
Cells(I, 6) = "x"
MailPerDay = MailPerDay - 1
If MailPerDay <= 0 Then Exit For
End If
Next I
Set OutApp = Nothing
End Sub
Le istruzioni marcate <<< sono da personalizzare come da commento.
In questo modo, tutte le volte che esegui la macro verranno inviate il numero di email impostato.
Ciao