Thanks for the link

I have heard of redemption but not quite sure how to apply it. I'm
assuming I would have to change my (Ron de Bruin's) entire code, which
I'd prefer not to do as its quite involved

I've installed Redemption but I'm lost as to how I tweak my code. My
original working code is below. It appears
that I need to place the following code somewhere in my code, but I
get a "property is read only" on the first line just below

   Set Session = CreateObject("Redemption.RDOSession")
   Session.Logon
   Set Drafts = Session.GetDefaultFolder(olFolderDrafts)
   Set Msg = Drafts.Items.Add
   Set Account = Session.Accounts("123 Reporting")
   Msg.Account = Account
   Msg.Send

On the site  http://www.dimastr.com/redemption/ FAQ # 14 it seems to
detail exactly what I want, but I don't know how to integrate it in my
code, the code they suggest is below

set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = MailItem
tag = sItem.GetIDsFromNames("{00020386-0000-0000-C000-000000000046}",
"From")
tag = tag or &H1E     'the type is PT_STRING8
sItem.Fields(Tag) = "Someone <whoever@domain.com>"
sItem.Subject = sItem.Subject  'to trick Outlook into thinking that
something has changed
sItem.Save

Sub Mail_From_Excel()
   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim Sourcewb As Workbook
   Dim Destwb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim OutApp As Object
   Dim OutMail As Object
   Dim sh As Worksheet

   With Application
       .ScreenUpdating = False
       .EnableEvents = False
   End With

   Set Sourcewb = ActiveWorkbook

   Sourcewb.Sheets(Array("Mail", "E-YTD")).Copy
   Set Destwb = ActiveWorkbook

   'Determine the Excel version and file extension/format
   With Destwb
       If Val(Application.Version) < 12 Then
           'You use Excel 97-2003
           FileExtStr = ".xls": FileFormatNum = -4143
       Else
           'You use Excel 2007
           'We exit the sub when your answer is NO in the security
dialog that you only
           'see  when you copy a sheet from a xlsm file with macro's
disabled.
           If Sourcewb.Name = .Name Then
               With Application
                   .ScreenUpdating = True
                   .EnableEvents = True
               End With
               MsgBox "Your answer is NO in the security dialog"
               Exit Sub
           Else
               Select Case Sourcewb.FileFormat
               Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
               Case 52:
                   If .HasVBProject Then
                       FileExtStr = ".xlsm": FileFormatNum = 52
                   Else
                       FileExtStr = ".xlsx": FileFormatNum = 51
                   End If
               Case 56: FileExtStr = ".xls": FileFormatNum = 56
               Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
               End Select
           End If
       End If
   End With

   TempFilePath = Environ$("temp") & "\"
   TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now,
"dd-
mmm-yy h-mm")

   ActiveWindow.TabRatio = 0.908

   Set OutApp = CreateObject("Outlook.Application")
   OutApp.Session.Logon
   Set OutMail = OutApp.CreateItem(0)

   For Each cell In ThisWorkbook.Sheets("Mail") _
   .Columns("BA").Cells.SpecialCells(xlCellTypeConstants)
       If cell.Value Like "?*@?*.?*" Then
           strto = strto & cell.Value & ";"
       End If
   Next
   strto = Left(strto, Len(strto) - 1)

   With Destwb
       .SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum

       On Error Resume Next
       With OutMail
           .To = ""
           .CC = ""
           .BCC = strto
           .Subject = ThisWorkbook.Sheets("Mail").Range("A1").Value
           .Body = ""
           .Attachments.Add Destwb.FullName
           .ReadReceiptRequested = True
           .Importance = 1
           .DeferredDeliveryTime =
ThisWorkbook.Sheets("Mail").Range("B1").Value
           .Send
       End With
       On Error GoTo 0
       .Close savechanges:=False
   End With

   Kill TempFilePath & TempFileName & FileExtStr

   Set OutMail = Nothing
   Set OutApp = Nothing

   With Application
       .ScreenUpdating = True
       .EnableEvents = True
   End With
End Sub