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
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
Code:
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