Sub inviamail()
Application.ScreenUpdating = False
Dim OutApp As Object
Dim EmailAddr As String
Dim subj As String
Dim BodyText As String
Sheets("Foglio1").Select
Columns("I:I").Select
Selection.NumberFormat = "$ #,##0.00"
Range("J2:J6500").NumberFormat = "mmmm/yyyy"
Range("O:P").ClearContents
rr = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To rr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.Createitem(0)
'On Error Resume Next
With OutMail
.To = Cells(i, 2)
.cc = Cells(i, 3)
.bcc = ""
.Subject = Cells(i, 4)
.body = Cells(i, 5)
'.Attachments.Add (Cells(i, 6) & Cells(i, 7)) codice che allega i file selezionati da  percorso

'.display questo comando visualizza la finestra del messaggio di outlook e in caso di
' invio di email multiple fa sfarfallare il monitor
.send
Application.SendKeys "%I" ' non fa uscire la finestra di Outlook che autorizza l'invio
End With
'On Error Resume Next 'con questo comando anche in caso di errore va avanti
On Error GoTo ERRORE
Cells(i, 15) = "INVIATA"
Set OutMail = Nothing
Set OutApp = Nothing
Application.SendKeys "%I"
Next i
ERRORE:
Cells(i, 16) = "ERRORE, NON INVIATA"
Application.ScreenUpdating = True
Resume Next
MsgBox ("Invio multimail completato")
End Sub