Sub Invia_Email_Ultima_Buona()

    Dim OutApp As Object

    Dim OutMail As Object

    Dim EmailAddr As String

    Dim Subj As String

    Dim BodyText As String

    

    Foglio1.Select

    

' RR contiene il numero di utenti cui inviare le e-mail (1 per utente)

    RR = Range("B" & Rows.Count).End(xlUp).Row

    

' I dati iniziano dalla seconda riga

    For I = 2 To RR

        Set OutApp = CreateObject("Outlook.Application")

        Set OutMail = OutApp.CreateItem(0)

        With OutMail

        

' La colonna "B" contiene gli indirizzi e-mail dei vari destinatari

                  .To = Cells(I, 2)

                  

' La colonna "C" contiene l'indirizzo e-mail in "Copia per Conoscenza"

                  .CC = Cells(I, 3)

                  

' Eventuale e-mail in "Copia per conoscenza nascosta"

                  .BCC = ""

                  

' La colonna "D" contiene l'oggetto della e-mail

                  .Subject = Cells(I, 4)

                  

' La colonna "E" contiene l testo della e-mail

                  .Body = Cells(I, 5)



' La colonna "F" contiene il percorso ove si trova il file da allegare

' La colonna "G" contiene il nome del file da allegare

                  .Attachments.Add (Cells(I, 6) & Cells(I, 7))
                  .Attachments.Add (Cells(I, 6) & Cells(I, 8))
                   .Attachments.Add (Cells(I, 6) & Cells(I, 9))

                  .Display

        End With

        Set OutMail = Nothing

        Set OutApp = Nothing

        Application.SendKeys "%a"

    Next I

End Sub