Microsoft Excel

Ron de Bruin
Excel Automation

Microsoft MVP Program

Mail one Sheet With Apple Mail

The code on this page is tested in OS X Lion and up with Excel 2011 and create the mail in Apple Mail.(default Mail program of the Mac OS X).

Because there are a few bugs in VBA SendMail in Excel we Run a AppleScript string with the built-in VBA MacScript function in the mail examples to get the same or better result.
Note: To run the mail examples you must copy the macro of your choice and also two functions named MailFromMacWithMail and KillFileOnMac that you find on the bottom of this page. Note: If you want to test more then one macro you only have to copy the two functions one time into your test workbook.

Tip : for more mail examples see this page : Send Mail from Mac Excel

 

Example

The following subroutine sends a newly created workbook with just the ActiveSheet.
It is saving the workbook before mailing it with a date/time stamp.
After the file is sent the workbook will be deleted from your hard disk.

Change the mail address in the macro before you run it, if you want to use multiple recipients separate them with an ,

Important: Read also the information below the macro

Sub Mail_ActiveSheet_In_Excel2011()
'For Excel 2011 for the Mac and Apple Mail
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    If Val(Application.Version) < 14 Then Exit Sub

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

    Set Sourcewb = ActiveWorkbook

    'Copy the ActiveSheet to a new workbook
    'You can also use Sheets("MySheetName").Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine file extension/format
    With Destwb
        Select Case Sourcewb.FileFormat
        Case 52: FileExtStr = ".xlsx": FileFormatNum = 52
        Case 53:
            If .HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 53
            Else
                FileExtStr = ".xlsx": FileFormatNum = 52
            End If
        Case 57: FileExtStr = ".xls": FileFormatNum = 57
        Case Else: FileExtStr = ".xlsb": FileFormatNum = 51
        End Select
    End With

    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = MacScript("return (path to documents folder) as string")
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        MailFromMacWithMail bodycontent:="Hi there", _
                    mailsubject:="Mail activesheet test", _
                    toaddress:="ron@debruin.nl", _
                    ccaddress:="", _
                    bccaddress:="", _
                    attachment:=.FullName, _
                    displaymail:=False
        .Close SaveChanges:=False
    End With

    Set Destwb = Nothing

    KillFileOnMac TempFilePath & TempFileName & FileExtStr

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

You can also use the following line if you know the sheet you want to mail :
Sheets("Sheet5").Copy
It doesn't have to be the active sheet used at that time.

 

Important Functions

Copy both functions below in a normal module of your workbook.
Without the functions the macro(s) above will not work.

Note: In the MailFromMacWithMail function I set visible:true but I really want to set it to false so I not see the screen flicker, but there is a bug that can give you the following problem: after you run one of the macro examples the mail will be send correct but if you want to close Apple Mail completely with cmd q for example it will popup the mail again and you must press the send button manual to send it again before you can close Apple Mail completely with cmd q. With visible:true you not have this problem, seems to be fixed when you run Excel 2011 in OS X El Capitan or up.

If you run the code in the new Mac OS Sierra you must comment or remove two lines in the function below to get the code working. On this moment signatures are not working in Sierra.

scriptToRun = scriptToRun & "set defaultSig to message signature" & Chr(13)
scriptToRun = scriptToRun & "set message signature to defaultSig" & Chr(13)

Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
                             toaddress As String, ccaddress As String, bccaddress As String, _
                             attachment As String, displaymail As Boolean)
'Ron de Bruin, function to Mail with Apple Mail, last update 6-Dec-2015
'Add a delay line to fix the attachment bug in El Capitan
'If it still not attach the attachment try to change the 1 to 2 in the delay line
'If you not use El Capitan you can change it to 0 or delete the line in this function
'You can use more mail addresses now in the To, CC and BCC, and it add the default signature
    Dim scriptToRun As String

    scriptToRun = scriptToRun & "tell application " & _
                  Chr(34) & "Mail" & Chr(34) & Chr(13)

    scriptToRun = scriptToRun & _
                  "set NewMail to make new outgoing message with properties " & _
                  "{subject:""" & mailsubject & """ , visible:true}" & Chr(13)

    scriptToRun = scriptToRun & "tell NewMail" & Chr(13)
    
    scriptToRun = scriptToRun & "set defaultSig to message signature" & Chr(13)
    scriptToRun = scriptToRun & "set content to """ & bodycontent & """ & return & return" & Chr(13)

    scriptToRun = scriptToRun & "set message signature to defaultSig" & Chr(13)

    If toaddress <> "" Then
        scriptToRun = scriptToRun & "set toaddressList to {" & _
                  Chr(34) & Replace(toaddress, ",", """,""") & Chr(34) & "}" & Chr(13)
        scriptToRun = scriptToRun & "repeat with i from 1 to count toaddressList" & Chr(13)
        scriptToRun = scriptToRun & "make new to recipient at end of to recipients with " & _
                     "properties {address:{item i of toaddressList}}" & Chr(13)
        scriptToRun = scriptToRun & "end repeat" & Chr(13)
    End If
    
    If ccaddress <> "" Then
        scriptToRun = scriptToRun & "set ccaddressList to {" & _
                  Chr(34) & Replace(ccaddress, ",", """,""") & Chr(34) & "}" & Chr(13)
        scriptToRun = scriptToRun & "repeat with i from 1 to count ccaddressList" & Chr(13)
        scriptToRun = scriptToRun & "make new cc recipient at end of cc recipients with " & _
                     "properties {address:{item i of ccaddressList}}" & Chr(13)
        scriptToRun = scriptToRun & "end repeat" & Chr(13)
    End If
    
    If bccaddress <> "" Then
        scriptToRun = scriptToRun & "set bccaddressList to {" & _
                  Chr(34) & Replace(bccaddress, ",", """,""") & Chr(34) & "}" & Chr(13)
        scriptToRun = scriptToRun & "repeat with i from 1 to count bccaddressList" & Chr(13)
        scriptToRun = scriptToRun & "make new bcc recipient at end of bcc recipients with " & _
                     "properties {address:{item i of bccaddressList}}" & Chr(13)
        scriptToRun = scriptToRun & "end repeat" & Chr(13)
    End If
           
    If attachment <> "" Then
        scriptToRun = scriptToRun & "tell content" & Chr(13)
        scriptToRun = scriptToRun & "make new attachment with properties " & _
                      "{file name:""" & attachment & """ as alias} " & _
                      "at after the last paragraph" & Chr(13)
        scriptToRun = scriptToRun & "Delay 1" & Chr(13)
        scriptToRun = scriptToRun & "end tell" & Chr(13)
    End If

    If displaymail = False Then
      scriptToRun = scriptToRun & "send" & Chr(13)
    Else
      scriptToRun = scriptToRun & "set visible to true" & Chr(13)
      scriptToRun = scriptToRun & "activate" & Chr(13)
    End If
    
    scriptToRun = scriptToRun & "end tell" & Chr(13)
    scriptToRun = scriptToRun & "end tell"

    If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
        MsgBox "There is no To, CC or BCC address or Subject for this mail"
        Exit Function
    Else
        On Error Resume Next
        MacScript (scriptToRun)
        On Error GoTo 0
    End If
End Function


Function KillFileOnMac(Filestr As String)
'Ron de Bruin, function to Kill file from Mac, 30-July-2012
'The VBA Kill command on a Mac will not work with long file names(28+ characters)
    Dim ScriptToKillFile As String
    ScriptToKillFile = ScriptToKillFile & "tell application " & Chr(34) & _
                       "Finder" & Chr(34) & Chr(13)
    ScriptToKillFile = ScriptToKillFile & _
                       "do shell script ""rm "" & quoted form of posix path of " & _
                       Chr(34) & Filestr & Chr(34) & Chr(13)
    ScriptToKillFile = ScriptToKillFile & "end tell"

    On Error Resume Next
    MacScript (ScriptToKillFile)
    On Error GoTo 0
End Function