Excel VBA code to work on MAC as well as it already does on Windows; to copy and save worksheet and generate email

[Lisa Harris]

Hi, I have the VBA code below working perfectly on my PC windows:

- Makes a copy of the required sheet (sheet 2 in this example)
- Saves it as an xlsx format so all formulas and macros removed, just values and formatting kept.
- Creates the filename using specified ranges given and file type (xlsx),
- Then saves in same folder as the opened macro document enabled from.
- An email is then generated throughout outlook with all the relevant fields populated and just need to add in the recipient (as different each time) and then send.​

However, there are also some MAC users, and none of this works! It creates a copy of the sheet correctly, but you have to specify which folder to save in and 'grant permission', then saves it as 'workbook 3', not saving it as the specified filename....or given there isn't a second workbook open, you would assume 'workbook 2' would be its default?

I would also like the email generation to choose whatever email program the user uses as many do not use Outlook, and especially MAC users, where they use 'Mail'.

Can anyone offer any insight on what I can do to allow this code to work on both Windows and a MAC (we use Mac book Pro with Office 365)? Or confirm if it is impossible on a MAC at least? Many thanks in advance.

Sub SaveAndSendSheet()
'
      Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
 
  ActiveSheet.Unprotect Password:="111111"
 
    If MsgBox("Are you sure you want to copy and email sheet 2?" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub
 
    With Application
        .ScreenUpdating = False
 
         '       Copy specific sheet
         '       *SET THE SHEET NAMES TO COPY BELOW*
 
 Sheets(Array("Sheet 2")).Copy
        On Error GoTo 0
 
         '       Paste sheets as values
         '       Remove External Links, Hyperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
 
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.[A1].PasteSpecial Paste:=xlFormats
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select
 
         '       What to name new file
        NewName = Range("D8").Value & "_" & Range("D9").Value & "_" & Range("E1").Value & "_V" & Range("D14").Value 'Change extension here
 
         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xlsx"
      
         MsgBox "Your Sheet 2 " & NewName & " has been saved"
         Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
 
Filename = ThisWorkbook.Path & "\" & NewName & ".xlsx"
 
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
    .to = ""
    .CC = "example@example.com"
    .BCC = ""
    .Subject = NewName & "_" & Range("D11").Value
    .Body = "Please find Sheet 2  attached for:" & vbNewLine & vbNewLine & NewName & "_" & Range("D11").Value & vbNewLine & vbNewLine & _
            "Any queries please let me know" & vbNewLine & vbNewLine & "Kind Regards" & vbNewLine & vbNewLine & Signature
    .Attachments.Add Filename
   
    .display
End With
        .ScreenUpdating = True
 
Dim wb As Workbook
 
    For Each wb In Workbooks
        If Not wb.FullName = ThisWorkbook.FullName Then wb.Close False
    Next
          
             ActiveSheet.Protect Password:="111111", _
      DrawingObjects:=True, Contents:=True, Scenarios:=True
 
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End With
 
End Sub