Microsoft Excel

Ron de Bruin
Excel Automation

Microsoft MVP Program

Mail more then 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



The following subroutine sends a newly created workbook with just the sheets in the Array.
.Sheets(Array("Sheet1", "Sheet3")).Copy

Use this if you want to send the selected sheets

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 ,

Sub Mail_Sheets_Array_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
    Dim sh As Worksheet
    Dim TheActiveWindow As Window
    Dim TempWindow As Window

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

    Set Sourcewb = ActiveWorkbook

    'Copy the sheets to a new workbook
    'We add a temporary Window to avoid the Copy problem
    'if there is a List or Table in one of the sheets and
    'if the sheets are grouped
    With Sourcewb
        Set TheActiveWindow = ActiveWindow
        Set TempWindow = .NewWindow
        .Sheets(Array("Sheet1", "Sheet3")).Copy
    End With

    'Close temporary Window

    Set Destwb = ActiveWorkbook

    'Determine the file extension/format
    With Destwb
        Select Case Sourcewb.FileFormat
        Case 52: FileExtStr = ".xlsx": FileFormatNum = 52
        Case 53:
            If .HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 53
                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 worksheets to values if you want
    '    For Each sh In Destwb.Worksheets
    '        sh.Select
    '        With sh.UsedRange
    '            .Cells.Copy
    '            .Cells.PasteSpecial xlPasteValues
    '            .Cells(1).Select
    '        End With
    '        Application.CutCopyMode = False
    '        Destwb.Worksheets(1).Select
    '    Next sh

    '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 more then one sheet test", _
                    toaddress:="", _
                    ccaddress:="", _
                    bccaddress:="", _
                    attachment:=.FullName, _
        .Close SaveChanges:=False
    End With

    Set Destwb = Nothing

    KillFileOnMac TempFilePath & TempFileName & FileExtStr

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


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)
      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
        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