Hey guys,

Quite annoyingly someone at the office requested that I port a Macro that works seamlessly on Windows Excel to the Mac Office 2011 Excel now that it supports VBA.

The Macro I am porting essentially creates an email (using outlook in windows) copies some data out of the current workbook to the emails body, and CREATES AND SAVES a new modified workbook in the same directory as the current workbook attaches the new workbook to the email.

There are 3 things I am having trouble with and would be very happy if someone could help me with:
1. How should I deal with the saving aspect? Mac OSX has a way different directory structure than windows, so creating and saving has been breaking now matter how I have tried it?

2. How do I get data out of the workbook and into the body of email. Right now I just have a Sheets("Name").Range("XX") that just gets implanted into the body using the Excel VBA outlook mail handler?

3. How do I get the Mac default Mail Handler to open a new message with the required information?


I am posting my code below so you can pick it apart and tell me how you think I should adapt it Mac Office 2011 VBA!!


I had to trim the code up because of the character limits. If you have any questions please let me know!

    
    
    

    
    
    Set rng = Sheets("Site Info").Range("C23")
    Set schd1 = Sheets("Site Info").Range("m7")
    'Set schd2 = Sheets("Site Info").Range("i8")
    'Set schd3 = Sheets("Site Info").Range("j8")
    Set schd4 = Sheets("Site Info").Range("m8")
   ' Set schd5 = Sheets("Site Info").Range("i9")
    'Set schd6 = Sheets("Site Info").Range("j9")
    Set schd7 = Sheets("Site Info").Range("M9")
   ' Set schd8 = Sheets("Site Info").Range("i10")
   ' Set schd9 = Sheets("Site Info").Range("j10")
   ' Set schd10 = Sheets("Site Info").Range("h11")
   ' Set schd11 = Sheets("Site Info").Range("i11")
   ' Set schd12 = Sheets("Site Info").Range("j11")
   ' Set schd13 = Sheets("Site Info").Range("h13")
   ' Set schd14 = Sheets("Site Info").Range("i13")

    
    Set site = Sheets("Site Info").Range("D5")
    Set wday = Sheets("Site Info").Range("m6")
    Set dday = Sheets("Site Info").Range("m5")
    Set comm = Sheets("Site Info").Range("C21")
    'Set qc = Sheets("Site Info").Range("i13:k14")
   '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
 Application.DisplayAlerts = False
  'code to save, overwrite, delete, whatever goes here


        For Each cell In Sheets("Email List").Columns("F").Cells.SpecialCells(xlCellTypeConstants)
        If LCase(Sheets("Email List").Cells(cell.Row, "B").Value) = "x" Then

    q = q & "; " & cell.Value
    Else
    If LCase(Sheets("Email List").Cells(cell.Row, "B").Value) = "c" Then

    c = c & "; " & cell.Value
   
        End If
        End If
    Next cell
     
     
   '  Application.DisplayAlerts = False
  'code to save, overwrite, delete, whatever goes here


'         For Each cell In Sheets("Email List").Columns("F").Cells.SpecialCells(xlCellTypeConstants)
'         If LCase(Sheets("Email List").Cells(cell.Row, "B").Value) = "c" Then
'
'     c = c & "; " & cell.Value
'
'         End If
'     Next cell
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
       Sheets(Array("site info", "comment sheet", "Details")).Copy
 
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select
         
         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm
    
    Application.DisplayAlerts = True
    
        TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
    NewName = TempFileName & FileExtStr
    
        
        
         '       Save it with the NewName and in the same directory as original
    '    ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName
     '   ActiveWorkbook.Close savechanges:=False
         
      '   Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & NewName)

  
    
    
    
    
tbody = "<TABLE class=MsoNormalTable style=""BORDER-COLLAPSE: collapse"" cellSpacing=0 cellPadding=0 border=0>" _
    & "<TBODY>"

tr1 = "<TR><TD Style = ""BORDER-RIGHT: black 1pt solid; PADDING-RIGHT: 0pt; BORDER-TOP: black 1pt solid; PADDING-LEFT: 0pt; PADDING-BOTTOM: 0in; BORDER-LEFT: black 1pt solid; WIDTH: 0%; PADDING-TOP: 0in; BORDER-BOTTOM: black 1pt solid""" _
    & "vAlign=top width=227><DIV><P class=MsoNormal><SPAN  style=""FONT-SIZE: 11pt; FONT-FAMILY: 'Calibri','sans-serif'"">Sch.</SPAN></P></DIV></TD>"
    
    

'tr2 = "<TD Style = ""BORDER-RIGHT: black 1pt solid; PADDING-RIGHT: 0pt; BORDER-TOP: black 1pt solid; PADDING-LEFT: 0pt; PADDING-BOTTOM: 0in; BORDER-LEFT: black 1pt solid; WIDTH: 0%; PADDING-TOP: 0in; BORDER-BOTTOM: black 1pt solid""" _
'    & "vAlign=top width=227><DIV><P class=MsoNormal><SPAN  style=""FONT-SIZE: 11pt; FONT-FAMILY: 'Calibri','sans-serif'"">Base.</SPAN></P></DIV></TD>"
    

'tr3 = "<TD Style = ""BORDER-RIGHT: black 1pt solid; PADDING-RIGHT: 0pt; BORDER-TOP: black 1pt solid; PADDING-LEFT: 0pt; PADDING-BOTTOM: 0in; BORDER-LEFT: black 1pt solid; WIDTH: 0%; PADDING-TOP: 0in; BORDER-BOTTOM: black 1pt solid""" _
'    & "vAlign=top width=227><DIV><P class=MsoNormal><SPAN  style=""FONT-SIZE: 11pt; FONT-FAMILY: 'Calibri','sans-serif'"">Est.</SPAN></P></DIV></TD>"
    

'tr4 = "<TD Style = ""BORDER-RIGHT: black 1pt solid; PADDING-RIGHT: 0pt; BORDER-TOP: black 1pt solid; PADDING-LEFT: 0pt; PADDING-BOTTOM: 0in; BORDER-LEFT: black 1pt solid; WIDTH: 0%; PADDING-TOP: 0in; BORDER-BOTTOM: black 1pt solid""" _
'    & "vAlign=top width=227><DIV><P class=MsoNormal><SPAN  style=""FONT-SIZE: 11pt; FONT-FAMILY: 'Calibri','sans-serif'"">Actl.</SPAN></P></DIV></TD></tr>"

'tr24 = "<TD Style = ""BORDER-RIGHT: black 1pt solid; PADDING-RIGHT: 0pt; BORDER-TOP: black 1pt solid; PADDING-LEFT: 0pt; PADDING-BOTTOM: 0in; BORDER-LEFT: black 1pt solid; WIDTH: 0%; PADDING-TOP: 0in; BORDER-BOTTOM: black 1pt solid""" _
    & "vAlign=top width=227><DIV><P class=MsoNormal><SPAN  style=""FONT-SIZE: 11pt; FONT-FAMILY: 'Calibri','sans-serif'""></SPAN></P></DIV></TD></TR></TBODY></TABLE>"
    


    
    
    
   
 
 br = "<br>"
 br2 = "<br><br>"
 intro = "<b><u>Attached is the Daily report for " & site & " on " & dday & ", " & wday & br2 & dday & ", " & wday & ":</u></b>" & br2
 comiss = "<B><u>Comments/Issues:</b></u><br>" & comm & br2
 acc = "<B><u>Accomplishment:</b></u><br>" & rng & br2
 sch = "<B><u>Schedule:</b></u>" & br2
 'qcc = "<B><u>Quality Control:</b></u>" & RangetoHTML(qc) & br2

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .to = q
        .CC = c
        .BCC = ""
        .Subject = site & "Survey" & " Daily report " & dday & ", " & wday
        .HTMLBody = intro & comiss & acc & sch & tbody & tr1 & tr2 & tr3 & tr4 & tr5 & tr6 & tr7 & tr8 & tr9 & tr10 & tr11 & tr12 & tr13 & tr14 & tr15 & tr16 & tr17 & tr18 & tr19 & tr20 & tr21 & tr22 & tr23 & tr24 & tr25 & tr26 & tr27 & tr28
'& qcc
        .Attachments.Add wb2.FullName
        .Display
    End With
    On Error GoTo 0
 wb2.Close savechanges:=False

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub