Option Explicit

Sub Mail()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''' ATTENZIONE RICHIEDE L'ATTIVAZIONE DELLA LIBRERIA MICROSOFT OUTLOOK 14.0 OBJECT LIBRARY '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''' Per l'attivazione andare su "Strumenti", "Riferimenti", cercare e spuntare il nome '''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim sAddr As String, sBody As String, sObj As String, sFrom As String, sAttc As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim x As Long, i As Long
  Dim ws As Worksheet
  
  Set ws = ThisWorkbook.Worksheets("Email")
  x = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
  
  Set oOUT = CreateObject("Outlook.Application")
  For i = 6 To x
  
    sAddr = Cells(i, 3) 'Destinatario
    sObj = Cells(i, 4) 'Oggetto
    sBody = Cells(i, 5) 'Testo
    sAddr = Cells(i, 6) 'Allegato
    sFrom = Cells(i, 2) 'Mittente
    
    Set oML = oOUT.CreateItem(olMailItem)
    With oML
      .Attachments.Add sAttc
      .To = sAddr
      .Subject = sObj
      .Body = sBody
      .SentOnBehalfOfName = sFrom
      .Display
      '.Send
    End With
  Next i
  Set oOUT = Nothing
  Set oML = Nothing
  Set ws = Nothing
End Sub