Microsoft Excel

Ron de Bruin
Excel Automation

Microsoft MVP Program

Mail every WorkSheet with address in A1 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

This procedure will mail every Worksheet with an address in cell A1. It does this by cycling through each worksheet in the workbook and checking cell A1 for the @ character.
If found, a copy of the worksheet is made and saved with a date/time stamp, and then sent by e-mail to the address in cell A1. And finally, the file is deleted from your hard disk

Note: Copy this macro in a standard module of the file with the sheets you want to send.
If you want to copy this macro in your Personal file change each ThisWorkbook
in the code to ActiveWorkbook

Sub Mail_Every_Worksheet_In_Excel2011()
'For Excel 2011 for the Mac and Apple Mail
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String

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

    TempFilePath = MacScript("return (path to documents folder) as string")

    'Determine the file extension/format
    Select Case ThisWorkbook.FileFormat
    Case 52: FileExtStr = ".xlsx": FileFormatNum = 52
    Case 53: FileExtStr = ".xlsm": FileFormatNum = 53
    Case 57: FileExtStr = ".xls": FileFormatNum = 57
    Case Else: FileExtStr = ".xlsb": FileFormatNum = 51
    End Select

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

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

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

            TempFileName = "Sheet " & sh.Name & " of " _
                    & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, _
                    FileFormat:=FileFormatNum
                MailFromMacWithMail bodycontent:="Hi there", _
                            mailsubject:="Every sheet with mail address in A1", _
                            toaddress:=sh.Range("A1").Value, _
                            ccaddress:="", _
                            bccaddress:="", _
                            attachment:=.FullName, _
                            displaymail:=False
                .Close SaveChanges:=False
            End With

            KillFileOnMac TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set wb = Nothing

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