Copying a range and sending in email

[elviajero]

I have found the following code and am trying to use it to copy Range A1:k50 in Sheet 1 and send it in the body of the email.

It works in so far as it will send an email when I run the code, but it is not including the text in range A1:K50. All that I get in the body of the email is "Hi There".

I'm a novice at vba so can anyone help to get this working so that the email includes the text from the selected range.

Thanks

Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
           toaddress As String, ccaddress As String, bccaddress As String, _
                attachment As String, displaymail As Boolean)

   
 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 " & _
            "{content:""" & bodycontent & """, subject:""" & _
               mailsubject & """ , visible:true}" & Chr(13)


    scriptToRun = scriptToRun & "tell NewMail" & Chr(13)


    If toaddress <> "" Then scriptToRun = scriptToRun & _
       "make new to recipient at end of to recipients with properties " & _
       "{address:""" & toaddress & """}" & Chr(13)


    If ccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new cc recipient at end of cc recipients with properties " & _
       "{address:""" & ccaddress & """}" & Chr(13)


    If bccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new bcc recipient at end of bcc recipients with properties " & _
       "{address:""" & bccaddress & """}" & Chr(13)


    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 & "end tell" & Chr(13)
    End If


    If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
    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)


'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
Sub Mail_Range_In_Excel2011()
'For Excel 2011 for the Mac and Apple Mail
    Dim Source As Range
    Dim Destwb As Workbook
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long


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


    Set Source = Nothing
    On Error Resume Next
    Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0


    If Source Is Nothing Then
        MsgBox "The source is not a range or the sheet is protected, " & _
               "please correct and try again.", vbOKOnly
        Exit Sub
    End If


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


    Set wb = ActiveWorkbook
    Set Destwb = Workbooks.Add(xlWBATWorksheet)


    Source.Copy
    With Destwb.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
    End With


    'Save format and extension
    FileExtStr = ".xlsx": FileFormatNum = 52


    'Or if you want it in xls format, use:
    'FileExtStr = ".xls": FileFormatNum = 57


    'Save the new workbook, mail it, and then delete it.
    'If you want to change the file name then change only TempFileName
    TempFilePath = MacScript("return (path to documents folder) as string")
    TempFileName = "Range of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")


    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        MailFromMacWithMail bodycontent:="Hi there", _
                    mailsubject:="Mail Range Test", _
                    toaddress:="a.person@yahoo.com", _
                    ccaddress:="", _
                    bccaddress:="", _
                    attachment:=.FullName, _
                    displaymail:=False
        .Close SaveChanges:=False
    End With


    KillFileOnMac TempFilePath & TempFileName & FileExtStr


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

 

[Jim Gordon]

Hi

This line of code is generating the "Hi There" message

[COLOR=#333333]MailFromMacWithMail bodycontent:="Hi there", _[/COLOR]