Save Excel File on Mac AND PC using VBA

Armygeddan

Board Regular
Joined
Apr 6, 2016
Messages
79
I have a Form I have my company use and some users use Macs but most use PC. The VBA below works 100% fine with PC users but since Mac's have a few different variances when it comes to File Path's I'm running into an issue of them using my form to save the file when clicking a button assigned with VBA.


Please note that I am trying Application.OperatingSystem code on Lines 37 and 94 but for some reason it still runs the entire code for Mac users while completely ignoring my If Statement for Operating System and reads it as PC


Here's what I have currently have:



Code:
    Sub SaveAndEmailAcquisition()


    Dim OutApp                As Object
    Dim OutMail               As Object


    Dim StrBody               As String
    Dim StrTo                 As String
    Dim StrSubject            As String
    Dim StrAtt                As String
    Dim StrSignature          As String
    Dim strGenericFilePath    As String: strGenericFilePath = "\\corp.company\folder1\folder2\folder3\"
    Dim strOSGenericFilePath  As String: strOSGenericFilePath = "~/Documents"
    Dim strYearSlash          As String: strYearSlash = Year(Date) & "\"
    Dim strMonthSlash         As String: strMonthSlash = CStr(Format(DateAdd("M", 0, Date), "MM")) & "\"
    Dim strYearBracket        As String: strYearBracket = Year(Date) & "_"
    Dim strMonthBracket       As String: strMonthBracket = CStr(Format(DateAdd("M", 0, Date), "MM")) & "_"
    Dim strFileName           As String: strFileName = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"
    Dim TheOS                 As String: TheOS = Application.OperatingSystem




    ' Creates Message Box asking if Form has been complete. If not, it cancels code to continue
    MSG1 = MsgBox("Have you filled out EVERY box of information on this form?", vbYesNo)


    If MSG1 = vbNo Then GoTo No
    If MSG1 = vbYes Then GoTo Yes
    No:
    MsgBox "Please fill out the remaining missing information and then click Save & Email"
    Exit Sub
    Yes:
    MsgBox "Thank you, please proceed"


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    ' VBA Command for Windows Users


    If Left(TheOS, 1) = "W" Then


    ' Check for Year Folder in V Drive and creates one if one doesn't exist


    If Len(Dir(strGenericFilePath & strYearSlash, vbDirectory)) = 0 
    Then
    MkDir strGenericFilePath & strYearSlash
    End If


    ' Check for Month Folder in V Drive and creates one if one doesn't exist


    If Len(Dir(strGenericFilePath & strYearSlash & strMonthSlash, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYearSlash & strMonthSlash
    End If


    ' Saves as Excel Macro Enabled book


    ActiveWorkbook.SaveAs strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


    ' Popup Message that the conversion and save is complete as 
    "YYYY_MM_Acquisition Title Procurement Request Form"


    MsgBox "File Saved As:" & vbNewLine & strYearBracket & strMonthBracket & strFileName


    ' Enter Subject here (Using NamedRange)
    StrSubject = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"


    ' Enter content of Email here
    StrBody = "Please see attached File," & "<BR><BR><BR>" & 
    vbNewLine & "Please list any additional details that I should know here that aren't listed on the form" & _
    "<br><br><br> Thanks,"


    ' Code that attaches the Document to the email
    StrAtt = ActiveWorkbook.FullName


    ' Who the email will be sent to
    StrTo = "YOUREMAIL@COMPANY.COM"


    ' Adds Company Signature to the end of the Email. No Signature without this code
    With OutMail
    .Display
    End With
    StrSignature = OutMail.Body


    With OutMail
    .To = StrTo
    .CC = ""
    .BCC = ""
    .Subject = StrSubject
    .HTMLBody = StrBody & .HTMLBody & vbNewLine & vbNewLine
    .Attachments.Add StrAtt
    .Display
    ' .Send (Not active, otherwise it will automatically send the email without review once user clicks Save & Email Button)
    End With


    ' VBA Command for Mac Users


    ElseIf Left(TheOS, 1) = "M" Then


    ' Saves as Excel Macro Enabled book


    ActiveWorkbook.SaveAs strOSGenericFilePath & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


    ' Popup Message that the conversion and save is complete as "Acquisition Title Procurement Request Form"


    MsgBox "File Saved As in your Documents Folder:" & vbNewLine & strFileName


    ' Enter Subject here (Using NamedRange)
    StrSubject = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"


    ' Enter content of Email here
    StrBody = "Please see attached File," & "<BR><BR><BR>" & 
    vbNewLine & "Please list any additional details that I should know here that aren't listed on the form" & _
    "<br><br><br> Thanks,"


    ' Code that attaches the Document to the email
    StrAtt = ActiveWorkbook.FullName


    ' Who the email will be sent to
    StrTo = "YOUREMAIL@COMPANY.COM"


    ' Adds Company Signature to the end of the Email. No Signature without this code
    With OutMail
    .Display
    End With
    StrSignature = OutMail.Body


    With OutMail
    .To = StrTo
    .CC = ""
    .BCC = ""
    .Subject = StrSubject
    .HTMLBody = StrBody & .HTMLBody & vbNewLine & vbNewLine
    .Attachments.Add StrAtt
    .Display
    ' .Send (Not active, otherwise it will automatically send the email without review once user clicks Save & Email Button)
    End With


    End If


    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing


    End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Based on what the article said (https://www.rondebruin.nl/mac/mac001.htm), I made the following modifications. I also took out all the folder creating code for PC users as it was causing an error for Mac users.


Mac users are now getting a "Compile Error: Can't find project or library" which I gather is because it was trying to read the PC FilePath which is what I'm trying to get Mac users to not read but instead save on their Desktop as detailed on the OS FilePath String. Here is what I have now:


Code:
Sub SaveAndEmailAcquisition()


    Dim OutApp                As Object
    Dim OutMail               As Object


    Dim StrBody               As String
    Dim StrTo                 As String
    Dim StrSubject            As String
    Dim StrAtt                As String
    Dim StrSignature          As String
    Dim strGenericFilePath    As String: strGenericFilePath = "\\corp.company\folder1\folder2\folder3\"
    Dim strOSGenericFilePath  As String: strOSGenericFilePath = "~/Documents"
    Dim strFileName           As String: strFileName = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"




    ' Creates Message Box asking if Form has been complete. If not, it cancels code to continue
    MSG1 = MsgBox("Have you filled out EVERY box of information on this form?", vbYesNo)


    If MSG1 = vbNo Then GoTo No
    If MSG1 = vbYes Then GoTo Yes
    No:
    MsgBox "Please fill out the remaining missing information and then click Save & Email"
    Exit Sub
    Yes:
    MsgBox "Thank you, please proceed"


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    ' VBA Command to test if user is a Mac user
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  Mac Then


    ' Saves as Excel Macro Enabled book
    ActiveWorkbook.SaveAs strGenericFilePath & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


    ' Popup Message that the conversion and save is complete as 
    "Acquisition Title Procurement Request Form"


    MsgBox "File Saved As:" & vbNewLine & strFileName


    ' Enter Subject here (Using NamedRange)
    StrSubject = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"


    ' Enter content of Email here
    StrBody = "Please see attached File," & "<BR><BR><BR>" & 
    vbNewLine & "Please list any additional details that I should know here that aren't listed on the form" & _
    "<br><br><br> Thanks,"


    ' Code that attaches the Document to the email
    StrAtt = ActiveWorkbook.FullName


    ' Who the email will be sent to
    StrTo = "YOUREMAIL@COMPANY.COM"


    ' Adds Company Signature to the end of the Email. No Signature without this code
    With OutMail
    .Display
    End With
    StrSignature = OutMail.Body


    With OutMail
    .To = StrTo
    .CC = ""
    .BCC = ""
    .Subject = StrSubject
    .HTMLBody = StrBody & .HTMLBody & vbNewLine & vbNewLine
    .Attachments.Add StrAtt
    .Display
    ' .Send (Not active, otherwise it will automatically send the email without review once user clicks Save & Email Button)
    End With


    ' VBA Command for PC Users
    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 


    ' Saves as Excel Macro Enabled book
    ActiveWorkbook.SaveAs strOSGenericFilePath & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


    ' Popup Message that the conversion and save is complete as "Acquisition Title Procurement Request Form"
    MsgBox "File Saved As in your Documents Folder:" & vbNewLine & strFileName


    ' Enter Subject here (Using NamedRange)
    StrSubject = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"


    ' Enter content of Email here
    StrBody = "Please see attached File," & "<BR><BR><BR>" & 
    vbNewLine & "Please list any additional details that I should know here that aren't listed on the form" & _
    "<br><br><br> Thanks,"


    ' Code that attaches the Document to the email
    StrAtt = ActiveWorkbook.FullName


    ' Who the email will be sent to
    StrTo = "YOUREMAIL@COMPANY.COM"


    ' Adds Company Signature to the end of the Email. No Signature without this code
    With OutMail
    .Display
    End With
    StrSignature = OutMail.Body


    With OutMail
    .To = StrTo
    .CC = ""
    .BCC = ""
    .Subject = StrSubject
    .HTMLBody = StrBody & .HTMLBody & vbNewLine & vbNewLine
    .Attachments.Add StrAtt
    .Display
    ' .Send (Not active, otherwise it will automatically send the email without review once user clicks Save & Email Button)
    End With


    [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  IF


    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing


    End Sub
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,179
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top