Microsoft Excel

Ron de Bruin
Excel Automation

Microsoft MVP Program

Mail worksheet in the body of the mail (Mac)

When you use the macro that send the mail directly I script the shortcut CMD Return now to send the mail and that is working OK. But I am still working to get the Apple Script send command working but this not seems to be easy.

Note: The code below will only work if you have Outlook as your default mail program.

Note: Both macro examples use this function: MailFromMacWithOutlookBody
Copy the macros and the function below in a new module in your workbook to test it.

Example code and function

The first macro display the mail and the second one directly send the mail. In the macro you see that the function call have 6 arguments.

The first one is the subject
The second one is the To line
The third one is the CC line (optional)
The fourth one is the BCC line (optional)
The fifth one is the attachment line(optional)
The last one you can use to display or send the mail

Note: Do not change the function MailFromMacWithOutlookBody, only change the arguments in the function calls in the macros below.

Tip: You can also use cell references as arguments if you want in the macros below.

Tip: If you want to mail to more then one person seperate each mail address with a comma in the To, CC and BCC line. You can also do this with attachments.

Sub DisplayActiveSheetInBodyMail()
MailFromMacwithOutlookBody mailsubject:="Mail Body ActiveSheet Display", _
                    toaddress:="ron@debruin.nl", _
                    ccaddress:="", _
                    bccaddress:="", _
                    attachment:="", _
                    displaymail:=True
End Sub

Sub SendActiveSheetInBodyMail()
MailFromMacwithOutlookBody mailsubject:="Mail Body ActiveSheet Send", _
                    toaddress:="ron@debruin.nl", _
                    ccaddress:="", _
                    bccaddress:="", _
                    attachment:="", _
                    displaymail:=False
End Sub


Function MailFromMacwithOutlookBody(mailsubject As String, toaddress As String, _
ccaddress As String, bccaddress As String, attachment As String, displaymail As Boolean)
'Ron de Bruin, function to Mail ActiveSheet with Outlook for the Mac(Body), 20-Aug-2013
    Dim scriptToRun As String

    Application.CommandBars(1).FindControl _
            (Id:=8611, Recursive:=True).Execute
    DoEvents

    scriptToRun = scriptToRun & "tell application " & _
            Chr(34) & "Microsoft Outlook" & Chr(34) & Chr(13)
    scriptToRun = scriptToRun & _
            "set theMessage to object of front window" & Chr(13)
       
    scriptToRun = scriptToRun & "tell application " & _
    Chr(34) & "System Events" & Chr(34) & Chr(13)
    scriptToRun = scriptToRun & "keystroke tab using shift down" & Chr(13)
    scriptToRun = scriptToRun & "end tell" & Chr(13)

    scriptToRun = scriptToRun & "tell theMessage" & Chr(13)
    scriptToRun = scriptToRun & "set subject to " & Chr(34) & mailsubject & Chr(34) & 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 {email address:{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 {email address:{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 {email address:{address:item i of bccaddressList}}" & Chr(13)
        scriptToRun = scriptToRun & "end repeat" & Chr(13)
    End If
    If attachment <> "" Then
        scriptToRun = scriptToRun & "set attachmentList to {" & _
                  Chr(34) & Replace(attachment, ",", """,""") & Chr(34) & "}" & Chr(13)
        scriptToRun = scriptToRun & "repeat with i from 1 to count attachmentList" & Chr(13)
        scriptToRun = scriptToRun & "make new attachment at end of attachments with " & _
                        "properties {file:item i of attachmentList}" & Chr(13)
        scriptToRun = scriptToRun & "end repeat" & Chr(13)
    End If
    scriptToRun = scriptToRun & "end tell" & Chr(13)
    scriptToRun = scriptToRun & "end tell" & Chr(13)

    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
        If displaymail = False Then
            scriptToRun = ""
            scriptToRun = scriptToRun & "tell application " & _
                Chr(34) & "System Events" & Chr(34) & Chr(13)
            scriptToRun = scriptToRun & "keystroke return using command down" & Chr(13)
            scriptToRun = scriptToRun & "end tell" & Chr(13)
            On Error Resume Next
            MacScript (scriptToRun)
            On Error GoTo 0
        End If
    End If
End Function