Sub Predisposizione_Mail_Outlook()
'Working in Excel 2000-2013
'La procedura prepara una mail per l'invio da un foglio excel

MsgBox ("Lancio procedura creazione ed invio mail")
    
'---- Dichiaraizone variabili -----------------------
     Dim sh As Worksheet
'    Dim objFSO As Object
'    Dim objFolder As Object
'    Dim objFile As Object
'-------------
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sPathAtt As String
    Dim sMail As String
    Dim sAtt As String
    Dim sCAtt As String
    Dim sFirme As String
    Dim sSignature As String
    Dim sNRecord As Integer
    Dim sRecord As Integer
    Dim sSendMail As String
    Dim sNoSendMail As String
    Dim sSender As String
  
    Dim objO As Object
    Dim obj As Outlook.MailItem
  
    Const virg As String = """"  '--- stringa per l'inserimento delle virgolette nell'oggetto della mail
  

'--- Settaggio variabili ----------------------------
     Set sh = ThisWorkbook.Worksheets("ELAB")
'    Set objFSO = CreateObject("Scripting.FileSystemObject")
'    Set objFolder = objFSO.GetFolder(sPath)
'-------------
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
'    Set objO = OutApp.MailItem(0)
    
    Set sh = ThisWorkbook.Worksheets("ELAB")
    

'--- Gestione errore --------------------------------
    On Error Resume Next
    
'--- Inserimento dati di riferimento ----------------
    sCountInizio = 2 'Numero riga primo record da elaborare
    sCountRecord = 2 'Numero riga ultimo record da elaborare       '--- TEST ---
    'sCountRecord = 100 'Numero riga ultimo record da elaborare
    sPathAtt = "C:ELAB"
    sFirme = "C:UsersuserAppDataRoamingMicrosoftSignaturesfirma.htm"
    sSender = "mittente@dominio.it"
    
'--- Calcolo numero di record -----------------------
    sNRecord = sCountRecord - sCountInizio + 2  '+2 per riga di intestazione ed elaborazione ultimo record
    

'--- Gestione Timbratura ----------------------------
    If Dir(sFirme) <> "" Then
        sSignature = GetBoiler(sFirme)
    Else
        sSignature = ""
    End If

    'sSignature = GetBoiler(sFirme)
     

'--- Creazione Mail ---------------------------------
    For sCount = 1 To sNRecord

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        
        sRecord = sCount + sCountInizio - 1
        sMail = Range("E" & sRecord).Value                      '--- email 
        sSendMail = Range("I" & sRecord).Value                  '--- Data invio mail
        sNoSendMail = Range("K" & sRecord).Value                '--- Record da non inviare se valorizzati
        
        If sSendMail <> "" Then GoTo Rinvio1 Else               '--- Rinvio a segnaposto se già inviata mail ---
        If sMail = "" Then GoTo Rinvio1 Else                    '--- Rinvio a segnaposto in assenza di indirizzo mail ---
        If sNoSendMail <> "" Then GoTo Rinvio1 Else             '--- Rinvio a segnaposto in caso di record da non elaborare ---
        
        sCAtt = Range("G" & sRecord).Value                      '--- Nominativo referente dell'Ente
        sAtt = sPathAtt & Range("A" & sRecord).Value & ".pdf"   '--- File da allegare: Lettera scansionata
        
        'sh.Select ("A" & sRecord)
                       
        'classe Oultook per vedere le proprietà previste
        'obj.Sender
        
        With OutMail
            '--- Vare soluzioni tentate
            '.SenderEmailAddress = sSender
            '.SenderEmailAddress = "mittente@dominio.it"
            '.From = "mittente@dominio.it"
            .From = sSender
            
            '--- Destinatari
            .To = "destinatario@dominio.it"                                                      '--- Impostazione di TEST ---
            '.To = sMail
            
            .CC = ""
            '.BCC = ""
            
            '--- Oggetto
            .Subject = "Oggetto_mail" & virg & " - TEST FINALE"    '--- Impostazione di TEST ---

            
            '--- Corpo del testo
            .HTMLBody = "Alla cortese attenzione del/della sig./sig.ra " & sCAtt _
                        & ". 

Distinti saluti. 

" _
                        & sSignature
            '.Body = "Alla Cortese attensione del/della sig./sig.ra " & sCAtt _
                        & vbCrLf _
                        & "Distinti saluti."
            
            '--- Allegato Workbook attivo
            '.Attachments.Add ActiveWorkbook.FullName
            
            '--- Allegati
            .Attachments.Add (sAtt)
            
            '--- Attività finale: invio, visualizzazione, salvataggio, ...
            .Display '.Send or .Display or .Save (per salvataggio in bozze ... si integrano)
            '.Send
        End With
        
        '--- Messaggio per la verifica e l'invio della mail ---
        ' è necessario inviare la mail prima di continuare con la procedura: in alternativa la procedura integrerà la prima mail creata con i dati dei successivi record
        
        MsgBox ("Verificare ed inviare la Mail prima di confermare")
        
        
        '--- Invio mail ---
        OutMail.Send
        
        '--- Inserimento info su record ---
        sh.Range("I" & sRecord).Value = Date
        sh.Range("j" & sRecord).Value = Time


'--- Segnaposto per ----------------------------
Rinvio1:

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Next
'---
    
    MsgBox ("n. " & sCount - 1 & " Mail elaborate")
    
    On Error GoTo 0

    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing
    Set sh = Nothing
    
    Set OutMail = Nothing
    Set OutApp = Nothing
        
End Sub

Function GetBoiler(ByVal sFile As String) As String
'--- Funzione per l'elaborazione della Firma da inserire nella mail ---

    Dim fso As Object
    Dim ts As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    
    GetBoiler = ts.readall
    ts.Close
    
End Function

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 indirizzo As String
  Dim oOUT As Outlook.Application
  Dim oML As MailItem
  Dim messaggio As String
  Dim oggetto As String
    
  messaggio = "tuo messaggio"
  oggetto = "tuo oggetto"
  indirizzo = "Pippo@Pappo.it"
  
  Set oOUT = CreateObject("Outlook.Application")
  Set oML = oOUT.CreateItem(olMailItem)
  
  With oML
    '.Attachments.Add ("C:	uo_file.pdf")
    .to = indirizzo
    .Subject = oggetto
    .body = messaggio
    .SentOnBehalfOfName = "ilmio@mittente.com"
    .Display
    '.Send
  End With
  
  Set oOUT = Nothing
  Set oML = Nothing
End Sub