Hi,

I have attached some working code which I use for an auto emailer in one of my workbooks. I have tried unsuccessfully to amend this code so that it will also mark the email as "Important" as well as providing me a "Delivery Receipt". I know this is possible, I just cannot figure it out... and I know it's probably something extremely easy, but nonetheless it continually evades me. Please help. And thanks in advance.

Code:
Sub SendEmail()

    Dim OutlookApp As Outlook.Application
    Dim MItem As Outlook.MailItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    Dim Msg As String
    
    'Create Outlook object
    Set OutlookApp = New Outlook.Application
    
    'Loop through the rows
    For Each cell In Columns("q").Cells.SpecialCells(xlCellTypeVisible)
        If cell.Value Like "*@*" Then
            EmailAddr = EmailAddr & ";" & cell.Value
        End If
    Next
    
    Msg = ""
    Msg = Msg & "All," & vbCrLf & vbCrLf
    Msg = Msg & "Please See Attachment. This is your copy of:  "

    Msg = Msg & Range("t6").Text & vbCrLf & vbCrLf 'Change the reference when needed -- DH
    Msg = Msg & "Of Contract #:  "
    Msg = Msg & Range("t5").Text & vbCrLf & vbCrLf 'Change the reference when needed -- DH
    Msg = Msg & "No Reply Necessary." & vbCrLf & vbCrLf
    Msg = Msg & "D.H." & vbCrLf
    Msg = Msg & "Contracts" & vbCrLf & vbCrLf & vbCrLf
        
    Subj = "New Contract For Your Copy"
    
    'Create Mail Item and view before sending
    Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Display
    End With

End Sub