VBA Excel Send Mail with Mailto

Di seguito una procedura scritta in VBA per la preparazione dell’invio di un messaggio di posta, utilizzando il client email di default del sistema operativo windows.

Come parametri, oltre all’indirizzo di destinazione del messaggio (To:) che è obbigatorio, può accettare gli indirizzi email in cc e bcc.

Fare attenzione che se vuole inserire nel parametro body, del testo su più righe, utilizzare il separatore %0D%0A

'Funzione utilizzata per eseguire un comando da shell (ShellExecute)
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'Procedura di preparazione messaggio mailto
Sub SendMailWithMailTo(to_email_address As String, cc_email_address As String, bcc_email_address As String, subject As String, body As String)
    
    If to_email_address = "" Then
    
       MsgBox "Impossibile inviare email. " & vbCrLf & "Non è presente l'indirizzo email di destinazione del messaggio." & vbCrLf & _
              "(Sub = SendMailWithMailTo) " & vbCrLf & "(" & Now() & ")", vbCritical
    
    Else
    
        Dim v_mailto As String
        v_mailto = "mailto:" & to_email_address
        
        'Se esiste almeno un parametro valorizzato aggiungo il carattere ?
        If cc_email_address <> "" Or bcc_email_address <> "" Or subject <> "" Or body <> "" Then
            v_mailto = v_mailto & "?"
        End If
        
        If cc_email_address <> "" Then
          v_mailto = v_mailto & "cc=" & cc_email_address & "&"
        End If
        
        If bcc_email_address <> "" Then
          v_mailto = v_mailto & "bcc=" & bcc_email_address & "&"
        End If
    
        If subject <> "" Then
          v_mailto = v_mailto & "subject=" & subject & "&"
        End If
        
        If body <> "" Then
          v_mailto = v_mailto & "body=" & body & "&"
        End If
        
        'Se esiste almeno un parametro valorizzato aggiungo tolgo l'ultimo carattere &
        If cc_email_address <> "" Or bcc_email_address <> "" Or subject <> "" Or body <> "" Then
        
            'MsgBox Len(v_mailto)
            v_mailto = Mid(v_mailto, 1, Len(v_mailto) - 1)
           
        End If
                    
        Dim result As Long
        result = ShellExecute(0&, "open", v_mailto, "", "", 1)
            
    End If
        
End Sub

Chiamata della procedura:

SendMailWithMailTo "'Mario Rossi' <email mario rossi>", "", "'Archivio' <email archivio>", "Oggetto mail", "Questa è la prima linea %0D%0A Questa è la seconda linea"

Per maggiori dettagli:
http://www.webfract.it/GUIDA/mailTo.htm
http://stackoverflow.com/questions/11507387/mailto-body-formatting